Merge branch 'master' of git://factorcode.org/git/factor into unicode
Daniel Ehrenberg
commit
e293856072
core
alien
c-types
compiler
bootstrap
compiler
dlists
float-vectors
generator
inference/dataflow
io/files
optimizer
backend
specializers
extra
benchmark
bootstrap2
fasta
reverse-complement
builder
bunny
cel-shaded
model
combinators/lib
contributors
core-foundation
db
postgresql
types
editors
factory/commands
hash2
hexdump
io
monitors
paths
unix
bsd
freebsd
linux
macosx
netbsd
openbsd
windows/nt
monitors
math
multiline
ogg/player
opengl/gl
optimizer/debugger
project-euler
004
017
019
021
028
030
034
035
036
039
042
043
044
045
046
048
053
055
056
075
092
common
sequences/lib
shuffle
taxes
|
|
@ -15,3 +15,5 @@ factor
|
|||
.gdb_history
|
||||
*.*.marks
|
||||
.*.swp
|
||||
reverse-complement-in.txt
|
||||
reverse-complement-out.txt
|
||||
|
|
|
|||
|
|
@ -167,7 +167,7 @@ DEFER: c-ushort-array>
|
|||
swap dup length memcpy ;
|
||||
|
||||
: string>char-memory ( string base -- )
|
||||
>r >byte-array r> byte-array>memory ;
|
||||
>r B{ } like r> byte-array>memory ;
|
||||
|
||||
DEFER: >c-ushort-array
|
||||
|
||||
|
|
|
|||
|
|
@ -398,7 +398,7 @@ TUPLE: callback-context ;
|
|||
callback-unwind %unwind ;
|
||||
|
||||
: generate-callback ( node -- )
|
||||
dup alien-callback-xt dup rot [
|
||||
dup alien-callback-xt dup [
|
||||
init-templates
|
||||
%save-word-xt
|
||||
%prologue-later
|
||||
|
|
@ -407,7 +407,7 @@ TUPLE: callback-context ;
|
|||
dup wrap-callback-quot %alien-callback
|
||||
%callback-return
|
||||
] with-stack-frame
|
||||
] generate-1 ;
|
||||
] with-generator ;
|
||||
|
||||
M: alien-callback generate-node
|
||||
end-basic-block generate-callback iterate-next ;
|
||||
|
|
|
|||
|
|
@ -111,7 +111,8 @@ SYMBOL: bootstrap-time
|
|||
"output-image" get resource-path save-image-and-exit
|
||||
] if
|
||||
] [
|
||||
print-error :c restarts.
|
||||
:c
|
||||
print-error restarts.
|
||||
"listener" vocab-main execute
|
||||
1 exit
|
||||
] recover
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@ IN: compiler
|
|||
|
||||
: compile-succeeded ( word -- effect dependencies )
|
||||
[
|
||||
dup word-dataflow >r swap dup r> optimize generate
|
||||
[ word-dataflow optimize ] keep dup generate
|
||||
] computing-dependencies ;
|
||||
|
||||
: compile-failed ( word error -- )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Mackenzie Straight, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators kernel math ;
|
||||
USING: combinators kernel math sequences ;
|
||||
IN: dlists
|
||||
|
||||
TUPLE: dlist front back length ;
|
||||
|
|
@ -72,6 +72,9 @@ PRIVATE>
|
|||
: push-front ( obj dlist -- )
|
||||
push-front* drop ;
|
||||
|
||||
: push-all-front ( seq dlist -- )
|
||||
[ push-front ] curry each ;
|
||||
|
||||
: push-back* ( obj dlist -- dlist-node )
|
||||
[ dlist-back f <dlist-node> ] keep
|
||||
[ dlist-back set-next-when ] 2keep
|
||||
|
|
@ -80,11 +83,10 @@ PRIVATE>
|
|||
inc-length ;
|
||||
|
||||
: push-back ( obj dlist -- )
|
||||
[ dlist-back f <dlist-node> ] keep
|
||||
[ dlist-back set-next-when ] 2keep
|
||||
[ set-dlist-back ] keep
|
||||
[ set-front-to-back ] keep
|
||||
inc-length ;
|
||||
push-back* drop ;
|
||||
|
||||
: push-all-back ( seq dlist -- )
|
||||
[ push-back ] curry each ;
|
||||
|
||||
: peek-front ( dlist -- obj )
|
||||
dlist-front dlist-node-obj ;
|
||||
|
|
@ -156,3 +158,6 @@ PRIVATE>
|
|||
over dlist-empty?
|
||||
[ 2drop ] [ [ >r pop-back r> call ] 2keep dlist-slurp ] if ;
|
||||
inline
|
||||
|
||||
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ $nl
|
|||
{ $subsection >float-vector }
|
||||
{ $subsection <float-vector> }
|
||||
"If you don't care about initial capacity, a more elegant way to create a new float vector is to write:"
|
||||
{ $code "BV{ } clone" } ;
|
||||
{ $code "FV{ } clone" } ;
|
||||
|
||||
ABOUT: "float-vectors"
|
||||
|
||||
|
|
|
|||
|
|
@ -140,17 +140,19 @@ SYMBOL: literal-table
|
|||
V{ } clone relocation-table set
|
||||
V{ } clone label-table set ;
|
||||
|
||||
: generate-labels ( -- labels )
|
||||
label-table get [
|
||||
: resolve-labels ( labels -- labels' )
|
||||
[
|
||||
first3 label-offset
|
||||
[ "Unresolved label" throw ] unless*
|
||||
3array
|
||||
] map concat ;
|
||||
|
||||
: fixup ( code -- relocation-table label-table code )
|
||||
: fixup ( code -- literals relocation labels code )
|
||||
[
|
||||
init-fixup
|
||||
dup stack-frame-size swap [ fixup* ] each drop
|
||||
|
||||
literal-table get >array
|
||||
relocation-table get >array
|
||||
generate-labels
|
||||
label-table get resolve-labels
|
||||
] { } make ;
|
||||
|
|
|
|||
|
|
@ -22,34 +22,35 @@ HELP: compiled
|
|||
{ $var-description "During compilation, holds a hashtable mapping words to 5-element arrays holding compiled code." } ;
|
||||
|
||||
HELP: compiling-word
|
||||
{ $var-description "The word currently being compiled, set by " { $link generate-1 } "." } ;
|
||||
{ $var-description "The word currently being compiled, set by " { $link with-generator } "." } ;
|
||||
|
||||
HELP: compiling-label
|
||||
{ $var-description "The label currently being compiled, set by " { $link generate-1 } "." } ;
|
||||
{ $var-description "The label currently being compiled, set by " { $link with-generator } "." } ;
|
||||
|
||||
HELP: compiled-stack-traces?
|
||||
{ $values { "?" "a boolean" } }
|
||||
{ $description "Iftrue, compiled code blocks will retain what word they were compiled from. This information is used by " { $link :c } " to display call stack traces after an error is thrown from compiled code. This is on by default; the deployment tool switches it off to save some space in the deployed image." } ;
|
||||
|
||||
HELP: literal-table
|
||||
{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link init-generator } " ensures that the first entry is the word being compiled." } ;
|
||||
{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link begin-compiling } " ensures that the first entry is the word being compiled." } ;
|
||||
|
||||
HELP: init-generator
|
||||
HELP: begin-compiling
|
||||
{ $values { "word" word } { "label" word } }
|
||||
{ $description "Prepares to generate machine code for a word." } ;
|
||||
|
||||
HELP: generate-1
|
||||
{ $values { "word" word } { "label" word } { "node" "a dataflow node" } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } }
|
||||
HELP: with-generator
|
||||
{ $values { "node" "a dataflow node" } { "word" word } { "label" word } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } }
|
||||
{ $description "Generates machine code for " { $snippet "label" } " by applying the quotation to the dataflow node." } ;
|
||||
|
||||
HELP: generate-node
|
||||
{ $values { "node" "a dataflow node" } { "next" "a dataflow node" } }
|
||||
{ $contract "Generates machine code for a dataflow node, and outputs the next node to generate machine code for." }
|
||||
{ $notes "This word can only be called from inside the quotation passed to " { $link generate-1 } "." } ;
|
||||
{ $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ;
|
||||
|
||||
HELP: generate-nodes
|
||||
{ $values { "node" "a dataflow node" } }
|
||||
{ $description "Recursively generate machine code for a dataflow graph." }
|
||||
{ $notes "This word can only be called from inside the quotation passed to " { $link generate-1 } "." } ;
|
||||
{ $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ;
|
||||
|
||||
HELP: generate
|
||||
{ $values { "word" word } { "label" word } { "node" "a dataflow node" } }
|
||||
|
|
|
|||
|
|
@ -11,12 +11,6 @@ IN: generator
|
|||
SYMBOL: compile-queue
|
||||
SYMBOL: compiled
|
||||
|
||||
: begin-compiling ( word -- )
|
||||
f swap compiled get set-at ;
|
||||
|
||||
: finish-compiling ( word literals relocation labels code -- )
|
||||
4array swap compiled get set-at ;
|
||||
|
||||
: queue-compile ( word -- )
|
||||
{
|
||||
{ [ dup compiled get key? ] [ drop ] }
|
||||
|
|
@ -32,24 +26,31 @@ SYMBOL: compiling-word
|
|||
|
||||
SYMBOL: compiling-label
|
||||
|
||||
SYMBOL: compiling-loop?
|
||||
|
||||
! Label of current word, after prologue, makes recursion faster
|
||||
SYMBOL: current-label-start
|
||||
|
||||
: compiled-stack-traces? ( -- ? ) 36 getenv ;
|
||||
|
||||
: init-generator ( -- )
|
||||
: begin-compiling ( word label -- )
|
||||
compiling-loop? off
|
||||
compiling-label set
|
||||
compiling-word set
|
||||
compiled-stack-traces?
|
||||
compiling-word get f ?
|
||||
1vector literal-table set ;
|
||||
compiling-word get f ?
|
||||
1vector literal-table set
|
||||
f compiling-word get compiled get set-at ;
|
||||
|
||||
: generate-1 ( word label node quot -- )
|
||||
pick begin-compiling [
|
||||
roll compiling-word set
|
||||
pick compiling-label set
|
||||
init-generator
|
||||
call
|
||||
literal-table get >array
|
||||
] { } make fixup finish-compiling ;
|
||||
: finish-compiling ( literals relocation labels code -- )
|
||||
4array compiling-label get compiled get set-at ;
|
||||
|
||||
: with-generator ( node word label quot -- )
|
||||
[
|
||||
>r begin-compiling r>
|
||||
{ } make fixup
|
||||
finish-compiling
|
||||
] with-scope ; inline
|
||||
|
||||
GENERIC: generate-node ( node -- next )
|
||||
|
||||
|
|
@ -62,12 +63,12 @@ GENERIC: generate-node ( node -- next )
|
|||
%prologue-later
|
||||
current-label-start define-label
|
||||
current-label-start resolve-label ;
|
||||
|
||||
: generate ( word label node -- )
|
||||
|
||||
: generate ( node word label -- )
|
||||
[
|
||||
init-generate-nodes
|
||||
[ generate-nodes ] with-node-iterator
|
||||
] generate-1 ;
|
||||
] with-generator ;
|
||||
|
||||
: word-dataflow ( word -- effect dataflow )
|
||||
[
|
||||
|
|
@ -82,25 +83,6 @@ GENERIC: generate-node ( node -- next )
|
|||
: if-intrinsics ( #call -- quot )
|
||||
node-param "if-intrinsics" word-prop ;
|
||||
|
||||
DEFER: #terminal?
|
||||
|
||||
PREDICATE: #merge #terminal-merge node-successor #terminal? ;
|
||||
|
||||
PREDICATE: #values #terminal-values node-successor #terminal? ;
|
||||
|
||||
PREDICATE: #call #terminal-call
|
||||
dup node-successor #if?
|
||||
over node-successor node-successor #terminal? and
|
||||
swap if-intrinsics and ;
|
||||
|
||||
UNION: #terminal
|
||||
POSTPONE: f #return #terminal-values #terminal-merge ;
|
||||
|
||||
: tail-call? ( -- ? )
|
||||
node-stack get [
|
||||
dup #terminal-call? swap node-successor #terminal? or
|
||||
] all? ;
|
||||
|
||||
! node
|
||||
M: node generate-node drop iterate-next ;
|
||||
|
||||
|
|
@ -112,20 +94,38 @@ M: node generate-node drop iterate-next ;
|
|||
: generate-call ( label -- next )
|
||||
dup maybe-compile
|
||||
end-basic-block
|
||||
tail-call? [
|
||||
%jump f
|
||||
dup compiling-label get eq? compiling-loop? get and [
|
||||
drop current-label-start get %jump-label f
|
||||
] [
|
||||
0 frame-required
|
||||
%call
|
||||
iterate-next
|
||||
tail-call? [
|
||||
%jump f
|
||||
] [
|
||||
0 frame-required
|
||||
%call
|
||||
iterate-next
|
||||
] if
|
||||
] if ;
|
||||
|
||||
! #label
|
||||
M: #label generate-node
|
||||
dup node-param generate-call >r
|
||||
dup #label-word over node-param rot node-child generate
|
||||
dup node-child over #label-word rot node-param generate
|
||||
r> ;
|
||||
|
||||
! #loop
|
||||
M: #loop generate-node
|
||||
end-basic-block
|
||||
[
|
||||
dup node-param compiling-label set
|
||||
current-label-start define-label
|
||||
current-label-start resolve-label
|
||||
compiling-loop? on
|
||||
node-child generate-nodes
|
||||
end-basic-block
|
||||
] with-scope
|
||||
init-templates
|
||||
iterate-next ;
|
||||
|
||||
! #if
|
||||
: end-false-branch ( label -- )
|
||||
tail-call? [ %return drop ] [ %jump-label ] if ;
|
||||
|
|
@ -150,12 +150,12 @@ M: #if generate-node
|
|||
! #dispatch
|
||||
: dispatch-branch ( node word -- label )
|
||||
gensym [
|
||||
rot [
|
||||
[
|
||||
copy-templates
|
||||
%save-dispatch-xt
|
||||
%prologue-later
|
||||
[ generate-nodes ] with-node-iterator
|
||||
] generate-1
|
||||
] with-generator
|
||||
] keep ;
|
||||
|
||||
: tail-dispatch? ( node -- ? )
|
||||
|
|
@ -182,10 +182,10 @@ M: #dispatch generate-node
|
|||
generate-dispatch iterate-next
|
||||
] [
|
||||
compiling-word get gensym [
|
||||
rot [
|
||||
[
|
||||
init-generate-nodes
|
||||
generate-dispatch
|
||||
] generate-1
|
||||
] with-generator
|
||||
] keep generate-call
|
||||
] if ;
|
||||
|
||||
|
|
@ -224,10 +224,11 @@ M: #dispatch generate-node
|
|||
: define-if-intrinsic ( word quot inputs -- )
|
||||
2array 1array define-if-intrinsics ;
|
||||
|
||||
: do-if-intrinsic ( #call pair -- next )
|
||||
<label> [ swap do-template ] keep
|
||||
>r node-successor r> generate-if
|
||||
node-successor ;
|
||||
: do-if-intrinsic ( pair -- next )
|
||||
<label> [
|
||||
swap do-template
|
||||
node> node-successor dup >node
|
||||
] keep generate-if ;
|
||||
|
||||
: find-intrinsic ( #call -- pair/f )
|
||||
intrinsics find-template ;
|
||||
|
|
@ -249,7 +250,7 @@ M: #call generate-node
|
|||
] [
|
||||
node-param generate-call
|
||||
] ?if
|
||||
] if* ;
|
||||
] ?if ;
|
||||
|
||||
! #call-label
|
||||
M: #call-label generate-node node-param generate-call ;
|
||||
|
|
@ -274,4 +275,6 @@ M: #r> generate-node
|
|||
iterate-next ;
|
||||
|
||||
! #return
|
||||
M: #return generate-node drop end-basic-block %return f ;
|
||||
M: #return generate-node
|
||||
node-param compiling-label get eq? compiling-loop? get and
|
||||
[ end-basic-block %return ] unless f ;
|
||||
|
|
|
|||
|
|
@ -97,11 +97,13 @@ M: object flatten-curry , ;
|
|||
|
||||
: node-child node-children first ;
|
||||
|
||||
TUPLE: #label word ;
|
||||
TUPLE: #label word loop? ;
|
||||
|
||||
: #label ( word label -- node )
|
||||
\ #label param-node [ set-#label-word ] keep ;
|
||||
|
||||
PREDICATE: #label #loop #label-loop? ;
|
||||
|
||||
TUPLE: #entry ;
|
||||
|
||||
: #entry ( -- node ) \ #entry all-out-node ;
|
||||
|
|
@ -304,3 +306,15 @@ SYMBOL: node-stack
|
|||
node-children
|
||||
[ last-node ] map
|
||||
[ #terminate? not ] subset ;
|
||||
|
||||
DEFER: #tail?
|
||||
|
||||
PREDICATE: #merge #tail-merge node-successor #tail? ;
|
||||
|
||||
PREDICATE: #values #tail-values node-successor #tail? ;
|
||||
|
||||
UNION: #tail
|
||||
POSTPONE: f #return #tail-values #tail-merge ;
|
||||
|
||||
: tail-call? ( -- ? )
|
||||
node-stack get [ node-successor #tail? ] all? ;
|
||||
|
|
|
|||
|
|
@ -141,37 +141,6 @@ C: <pathname> pathname
|
|||
|
||||
M: pathname <=> [ pathname-string ] compare ;
|
||||
|
||||
HOOK: library-roots io-backend ( -- seq )
|
||||
HOOK: binary-roots io-backend ( -- seq )
|
||||
|
||||
: find-file ( seq str -- path/f )
|
||||
[
|
||||
[ path+ exists? ] curry find nip
|
||||
] keep over [ path+ ] [ drop ] if ;
|
||||
|
||||
: find-library ( str -- path/f )
|
||||
library-roots swap find-file ;
|
||||
|
||||
: find-binary ( str -- path/f )
|
||||
binary-roots swap find-file ;
|
||||
|
||||
<PRIVATE
|
||||
: append-path ( path files -- paths )
|
||||
[ path+ ] with map ;
|
||||
|
||||
: get-paths ( dir -- paths )
|
||||
dup directory keys append-path ;
|
||||
|
||||
: (walk-dir) ( path -- )
|
||||
dup directory? [
|
||||
get-paths dup % [ (walk-dir) ] each
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
PRIVATE>
|
||||
|
||||
: walk-dir ( path -- seq ) [ (walk-dir) ] { } make ;
|
||||
|
||||
: file-lines ( path -- seq ) <file-reader> lines ;
|
||||
|
||||
: file-contents ( path -- str )
|
||||
|
|
|
|||
|
|
@ -367,6 +367,10 @@ DEFER: (flat-length)
|
|||
dup node-param dup +inlined+ depends-on
|
||||
word-def splice-quot ;
|
||||
|
||||
: method-body-inline? ( #call -- ? )
|
||||
node-param dup method-body?
|
||||
[ flat-length 8 <= ] [ drop f ] if ;
|
||||
|
||||
M: #call optimize-node*
|
||||
{
|
||||
{ [ dup flush-eval? ] [ flush-eval ] }
|
||||
|
|
@ -375,5 +379,6 @@ M: #call optimize-node*
|
|||
{ [ dup optimizer-hook ] [ optimize-hook ] }
|
||||
{ [ dup optimize-predicate? ] [ optimize-predicate ] }
|
||||
{ [ dup optimistic-inline? ] [ optimistic-inline ] }
|
||||
{ [ dup method-body-inline? ] [ optimistic-inline ] }
|
||||
{ [ t ] [ inline-method ] }
|
||||
} cond dup not ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,62 @@
|
|||
IN: temporary
|
||||
USING: tools.test optimizer.control combinators kernel
|
||||
sequences inference.dataflow math inference ;
|
||||
|
||||
: label-is-loop? ( node word -- ? )
|
||||
[
|
||||
{
|
||||
{ [ over #label? not ] [ 2drop f ] }
|
||||
{ [ over #label-word over eq? not ] [ 2drop f ] }
|
||||
{ [ over #label-loop? not ] [ 2drop f ] }
|
||||
{ [ t ] [ 2drop t ] }
|
||||
} cond
|
||||
] curry node-exists? ;
|
||||
|
||||
: label-is-not-loop? ( node word -- ? )
|
||||
[
|
||||
{
|
||||
{ [ over #label? not ] [ 2drop f ] }
|
||||
{ [ over #label-word over eq? not ] [ 2drop f ] }
|
||||
{ [ over #label-loop? ] [ 2drop f ] }
|
||||
{ [ t ] [ 2drop t ] }
|
||||
} cond
|
||||
] curry node-exists? ;
|
||||
|
||||
: loop-test-1 ( a -- )
|
||||
dup [ 1+ loop-test-1 ] [ drop ] if ; inline
|
||||
|
||||
[ t ] [
|
||||
[ loop-test-1 ] dataflow dup detect-loops
|
||||
\ loop-test-1 label-is-loop?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ loop-test-1 1 2 3 ] dataflow dup detect-loops
|
||||
\ loop-test-1 label-is-loop?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ [ loop-test-1 ] each ] dataflow dup detect-loops
|
||||
\ loop-test-1 label-is-loop?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ [ loop-test-1 ] each ] dataflow dup detect-loops
|
||||
\ (each-integer) label-is-loop?
|
||||
] unit-test
|
||||
|
||||
: loop-test-2 ( a -- )
|
||||
dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline
|
||||
|
||||
[ t ] [
|
||||
[ loop-test-2 ] dataflow dup detect-loops
|
||||
\ loop-test-2 label-is-not-loop?
|
||||
] unit-test
|
||||
|
||||
: loop-test-3 ( a -- )
|
||||
dup [ [ loop-test-3 ] each ] [ drop ] if ; inline
|
||||
|
||||
[ t ] [
|
||||
[ loop-test-3 ] dataflow dup detect-loops
|
||||
\ loop-test-3 label-is-not-loop?
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel inference.dataflow combinators sequences
|
||||
namespaces math ;
|
||||
IN: optimizer.control
|
||||
|
||||
GENERIC: detect-loops* ( node -- )
|
||||
|
||||
M: node detect-loops* drop ;
|
||||
|
||||
M: #label detect-loops* t swap set-#label-loop? ;
|
||||
|
||||
: not-a-loop ( #label -- )
|
||||
f swap set-#label-loop? ;
|
||||
|
||||
: tail-call? ( -- ? )
|
||||
node-stack get
|
||||
dup [ #label? ] find-last drop [ 1+ ] [ 0 ] if* tail
|
||||
[ node-successor #tail? ] all? ;
|
||||
|
||||
: detect-loop ( seen-other? label node -- seen-other? continue? )
|
||||
#! seen-other?: have we seen another label?
|
||||
{
|
||||
{ [ dup #label? not ] [ 2drop t ] }
|
||||
{ [ 2dup node-param eq? not ] [ 3drop t t ] }
|
||||
{ [ tail-call? not ] [ not-a-loop drop f ] }
|
||||
{ [ pick ] [ not-a-loop drop f ] }
|
||||
{ [ t ] [ 2drop f ] }
|
||||
} cond ;
|
||||
|
||||
M: #call-label detect-loops*
|
||||
f swap node-param node-stack get <reversed>
|
||||
[ detect-loop ] with all? 2drop ;
|
||||
|
||||
: detect-loops ( node -- )
|
||||
[ detect-loops* ] each-node ;
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces optimizer.backend optimizer.def-use
|
||||
optimizer.known-words optimizer.math inference.class ;
|
||||
optimizer.known-words optimizer.math optimizer.control
|
||||
inference.class ;
|
||||
IN: optimizer
|
||||
|
||||
: optimize-1 ( node -- newnode ? )
|
||||
|
|
@ -11,6 +12,7 @@ IN: optimizer
|
|||
H{ } clone value-substitutions set
|
||||
dup compute-def-use
|
||||
kill-values
|
||||
! dup detect-loops
|
||||
dup infer-classes
|
||||
optimizer-changed off
|
||||
optimize-nodes
|
||||
|
|
|
|||
|
|
@ -24,16 +24,18 @@ IN: optimizer.specializers
|
|||
\ dispatch ,
|
||||
] [ ] make ;
|
||||
|
||||
: specializer-methods ( word -- alist )
|
||||
dup [ array? ] all? [ 1array ] unless [
|
||||
[ make-specializer ] keep
|
||||
[ declare ] curry pick append
|
||||
] { } map>assoc ;
|
||||
|
||||
: specialized-def ( word -- quot )
|
||||
dup word-def swap "specializer" word-prop [
|
||||
dup { number } = [
|
||||
drop tag-specializer
|
||||
] [
|
||||
dup [ array? ] all? [ 1array ] unless [
|
||||
[ make-specializer ] keep
|
||||
[ declare ] curry pick append
|
||||
] { } map>assoc
|
||||
alist>quot
|
||||
specializer-methods alist>quot
|
||||
] if
|
||||
] when* ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,12 +1,14 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel vocabs vocabs.loader tools.time tools.browser
|
||||
arrays assocs io.styles io help.markup prettyprint sequences ;
|
||||
arrays assocs io.styles io help.markup prettyprint sequences
|
||||
continuations debugger ;
|
||||
IN: benchmark
|
||||
|
||||
: run-benchmark ( vocab -- result )
|
||||
"=== Benchmark " write dup print flush
|
||||
dup require [ run ] benchmark 2array
|
||||
dup require
|
||||
[ [ run ] benchmark ] [ error. f f ] recover 2array
|
||||
dup . ;
|
||||
|
||||
: run-benchmarks ( -- assoc )
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
USING: io.files io.launcher system bootstrap.image
|
||||
namespaces sequences kernel ;
|
||||
IN: benchmark.bootstrap2
|
||||
|
||||
: bootstrap-benchmark
|
||||
"." resource-path cd
|
||||
[
|
||||
vm ,
|
||||
"-i=" my-boot-image-name append ,
|
||||
"-output-image=foo.image" ,
|
||||
"-no-user-init" ,
|
||||
] { } make try-process ;
|
||||
|
||||
MAIN: bootstrap-benchmark
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
|
||||
USING: math kernel io io.files locals multiline assocs sequences
|
||||
sequences.private benchmark.reverse-complement hints
|
||||
byte-arrays float-arrays ;
|
||||
IN: benchmark.fasta
|
||||
|
||||
: IM 139968 ; inline
|
||||
: IA 3877 ; inline
|
||||
: IC 29573 ; inline
|
||||
: initial-seed 42 ; inline
|
||||
: line-length 60 ; inline
|
||||
|
||||
USE: math.private
|
||||
|
||||
: random ( seed -- n seed )
|
||||
>float IA * IC + IM mod [ IM /f ] keep ; inline
|
||||
|
||||
HINTS: random fixnum ;
|
||||
|
||||
: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA" ; inline
|
||||
|
||||
: IUB
|
||||
{
|
||||
{ CHAR: a 0.27 }
|
||||
{ CHAR: c 0.12 }
|
||||
{ CHAR: g 0.12 }
|
||||
{ CHAR: t 0.27 }
|
||||
|
||||
{ CHAR: B 0.02 }
|
||||
{ CHAR: D 0.02 }
|
||||
{ CHAR: H 0.02 }
|
||||
{ CHAR: K 0.02 }
|
||||
{ CHAR: M 0.02 }
|
||||
{ CHAR: N 0.02 }
|
||||
{ CHAR: R 0.02 }
|
||||
{ CHAR: S 0.02 }
|
||||
{ CHAR: V 0.02 }
|
||||
{ CHAR: W 0.02 }
|
||||
{ CHAR: Y 0.02 }
|
||||
} ; inline
|
||||
|
||||
: homo-sapiens
|
||||
{
|
||||
{ CHAR: a 0.3029549426680 }
|
||||
{ CHAR: c 0.1979883004921 }
|
||||
{ CHAR: g 0.1975473066391 }
|
||||
{ CHAR: t 0.3015094502008 }
|
||||
} ; inline
|
||||
|
||||
: make-cumulative ( freq -- chars floats )
|
||||
dup keys >byte-array
|
||||
swap values >float-array unclip [ + ] accumulate swap add ;
|
||||
|
||||
:: select-random | seed chars floats |
|
||||
floats seed random -rot
|
||||
[ >= ] curry find drop
|
||||
chars nth-unsafe ; inline
|
||||
|
||||
: make-random-fasta ( seed len chars floats -- seed )
|
||||
[ rot drop select-random ] 2curry B{ } map-as print ; inline
|
||||
|
||||
: write-description ( desc id -- )
|
||||
">" write write bl print ; inline
|
||||
|
||||
:: split-lines | n quot |
|
||||
n line-length /mod
|
||||
[ [ line-length quot call ] times ] dip
|
||||
dup zero? [ drop ] quot if ; inline
|
||||
|
||||
: write-random-fasta ( seed n chars floats desc id -- seed )
|
||||
write-description
|
||||
[ make-random-fasta ] 2curry split-lines ; inline
|
||||
|
||||
:: make-repeat-fasta | k len alu |
|
||||
[let | kn [ alu length ] |
|
||||
len [ k + kn mod alu nth-unsafe ] B{ } map-as print
|
||||
k len +
|
||||
] ; inline
|
||||
|
||||
: write-repeat-fasta ( n alu desc id -- )
|
||||
write-description
|
||||
[let | k! [ 0 ] alu [ ] |
|
||||
[| len | k len alu make-repeat-fasta k! ] split-lines
|
||||
] with-locals ; inline
|
||||
|
||||
: fasta ( n out -- )
|
||||
homo-sapiens make-cumulative
|
||||
IUB make-cumulative
|
||||
[let | homo-sapiens-floats [ ]
|
||||
homo-sapiens-chars [ ]
|
||||
IUB-floats [ ]
|
||||
IUB-chars [ ]
|
||||
out [ ]
|
||||
n [ ]
|
||||
seed [ initial-seed ] |
|
||||
|
||||
out [
|
||||
n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta
|
||||
|
||||
initial-seed
|
||||
n 3 * homo-sapiens-chars homo-sapiens-floats "IUB ambiguity codes" "TWO" write-random-fasta
|
||||
n 5 * IUB-chars IUB-floats "Homo sapiens frequency" "THREE" write-random-fasta
|
||||
drop
|
||||
] with-file-out
|
||||
|
||||
] with-locals ;
|
||||
|
||||
: run-fasta 2500000 reverse-complement-in fasta ;
|
||||
|
||||
MAIN: run-fasta
|
||||
|
|
@ -36,10 +36,17 @@ HINTS: do-line vector string ;
|
|||
500000 <vector> (reverse-complement)
|
||||
] with-stream ;
|
||||
|
||||
: reverse-complement-in
|
||||
"extra/benchmark/reverse-complement/reverse-complement-in.txt"
|
||||
resource-path ;
|
||||
|
||||
: reverse-complement-out
|
||||
"extra/benchmark/reverse-complement/reverse-complement-out.txt"
|
||||
resource-path ;
|
||||
|
||||
: reverse-complement-main ( -- )
|
||||
"extra/benchmark/reverse-complement/reverse-complement-test-in.txt"
|
||||
"extra/benchmark/reverse-complement/reverse-complement-test-out.txt"
|
||||
[ resource-path ] 2apply
|
||||
reverse-complement-in
|
||||
reverse-complement-out
|
||||
reverse-complement ;
|
||||
|
||||
MAIN: reverse-complement-main
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
|
||||
USING: kernel io io.files io.launcher io.sockets hashtables math threads
|
||||
system continuations namespaces sequences splitting math.parser
|
||||
USING: kernel parser io io.files io.launcher io.sockets hashtables math threads
|
||||
arrays system continuations namespaces sequences splitting math.parser
|
||||
prettyprint tools.time calendar bake vars http.client
|
||||
combinators bootstrap.image bootstrap.image.download
|
||||
combinators.cleave ;
|
||||
combinators.cleave benchmark ;
|
||||
|
||||
IN: builder
|
||||
|
||||
|
|
@ -11,20 +11,7 @@ IN: builder
|
|||
|
||||
: runtime ( quot -- time ) benchmark nip ;
|
||||
|
||||
: log-runtime ( quot file -- )
|
||||
>r runtime r> <file-writer> [ . ] with-stream ;
|
||||
|
||||
: log-object ( object file -- ) <file-writer> [ . ] with-stream ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: datestamp ( -- string )
|
||||
now `{ ,[ dup timestamp-year ]
|
||||
,[ dup timestamp-month ]
|
||||
,[ dup timestamp-day ]
|
||||
,[ dup timestamp-hour ]
|
||||
,[ timestamp-minute ] }
|
||||
[ pad-00 ] map "-" join ;
|
||||
: minutes>ms ( min -- ms ) 60 * 1000 * ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -48,23 +35,8 @@ SYMBOL: builder-recipients
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: run-or-notify ( desc message -- )
|
||||
[ [ try-process ] curry ]
|
||||
[ [ email-string throw ] curry ]
|
||||
bi*
|
||||
recover ;
|
||||
|
||||
: run-or-send-file ( desc message file -- )
|
||||
>r >r [ try-process ] curry
|
||||
r> r> [ email-file throw ] 2curry
|
||||
recover ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: factor-binary ( -- name )
|
||||
os
|
||||
{ { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] }
|
||||
|
|
@ -72,12 +44,6 @@ SYMBOL: builder-recipients
|
|||
[ drop "./factor" ] }
|
||||
case ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: stamp
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: git-pull ( -- desc )
|
||||
{
|
||||
"git"
|
||||
|
|
@ -89,16 +55,30 @@ VAR: stamp
|
|||
|
||||
: git-clone ( -- desc ) { "git" "clone" "../factor" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: datestamp ( -- string )
|
||||
now `{ ,[ dup timestamp-year ]
|
||||
,[ dup timestamp-month ]
|
||||
,[ dup timestamp-day ]
|
||||
,[ dup timestamp-hour ]
|
||||
,[ timestamp-minute ] }
|
||||
[ pad-00 ] map "-" join ;
|
||||
|
||||
VAR: stamp
|
||||
|
||||
: enter-build-dir ( -- )
|
||||
datestamp >stamp
|
||||
"/builds" cd
|
||||
stamp> make-directory
|
||||
stamp> cd ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: git-id ( -- id )
|
||||
{ "git" "show" } <process-stream> [ readln ] with-stream " " split second ;
|
||||
|
||||
: record-git-id ( -- ) git-id "../git-id" log-object ;
|
||||
: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-out ;
|
||||
|
||||
: make-clean ( -- desc ) { "make" "clean" } ;
|
||||
|
||||
|
|
@ -110,13 +90,6 @@ VAR: stamp
|
|||
}
|
||||
>hashtable ;
|
||||
|
||||
: retrieve-boot-image ( -- )
|
||||
[ my-arch download-image ]
|
||||
[ ]
|
||||
[ "builder: image download" email-string ]
|
||||
cleanup
|
||||
flush ;
|
||||
|
||||
: bootstrap ( -- desc )
|
||||
`{
|
||||
{ +arguments+ {
|
||||
|
|
@ -126,46 +99,92 @@ VAR: stamp
|
|||
} }
|
||||
{ +stdout+ "../boot-log" }
|
||||
{ +stderr+ +stdout+ }
|
||||
}
|
||||
>hashtable ;
|
||||
{ +timeout+ ,[ 20 minutes>ms ] }
|
||||
} ;
|
||||
|
||||
: builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: build-status
|
||||
|
||||
: build ( -- )
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
enter-build-dir
|
||||
: milli-seconds>time ( n -- string )
|
||||
1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
|
||||
|
||||
: eval-file ( file -- obj ) <file-reader> contents eval ;
|
||||
|
||||
git-clone "git clone error" run-or-notify
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
"factor" cd
|
||||
: cat ( file -- ) <file-reader> contents print ;
|
||||
|
||||
record-git-id
|
||||
|
||||
make-clean "make clean error" run-or-notify
|
||||
|
||||
make-vm "vm compile error" "../compile-log" run-or-send-file
|
||||
|
||||
retrieve-boot-image
|
||||
|
||||
bootstrap "bootstrap error" "../boot-log" run-or-send-file
|
||||
|
||||
builder-test "builder.test fatal error" run-or-notify
|
||||
|
||||
"../load-everything-log" exists?
|
||||
[ "load-everything" "../load-everything-log" email-file ]
|
||||
when
|
||||
|
||||
"../failing-tests" exists?
|
||||
[ "failing tests" "../failing-tests" email-file ]
|
||||
when ;
|
||||
: run-or-bail ( desc quot -- )
|
||||
[ [ try-process ] curry ]
|
||||
[ [ throw ] curry ]
|
||||
bi*
|
||||
recover ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: minutes>ms ( min -- ms ) 60 * 1000 * ;
|
||||
: (build) ( -- )
|
||||
|
||||
enter-build-dir
|
||||
|
||||
"report" [
|
||||
|
||||
"Build machine: " write host-name print
|
||||
"Build directory: " write cwd print
|
||||
|
||||
git-clone [ "git clone failed" print ] run-or-bail
|
||||
|
||||
"factor" cd
|
||||
|
||||
record-git-id
|
||||
|
||||
make-clean run-process drop
|
||||
|
||||
make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail
|
||||
|
||||
[ my-arch download-image ] [ "Image download error" print throw ] recover
|
||||
|
||||
! bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
|
||||
|
||||
! bootstrap
|
||||
! <process-stream> dup dispose process-stream-process wait-for-process
|
||||
! zero? not
|
||||
! [ "Bootstrap error" print "../boot-log" cat "bootstrap error" throw ]
|
||||
! when
|
||||
|
||||
[
|
||||
bootstrap
|
||||
<process-stream> dup dispose process-stream-process wait-for-process
|
||||
zero? not
|
||||
[ "bootstrap non-zero" throw ]
|
||||
when
|
||||
]
|
||||
[ "Bootstrap error" print "../boot-log" cat "bootstrap" throw ]
|
||||
recover
|
||||
|
||||
[ builder-test try-process ]
|
||||
[ "Builder test error" print throw ]
|
||||
recover
|
||||
|
||||
"Boot time: " write "../boot-time" eval-file milli-seconds>time print
|
||||
"Load time: " write "../load-time" eval-file milli-seconds>time print
|
||||
"Test time: " write "../test-time" eval-file milli-seconds>time print
|
||||
|
||||
"Did not pass load-everything: " print "../load-everything-vocabs" cat
|
||||
"Did not pass test-all: " print "../test-all-vocabs" cat
|
||||
|
||||
"Benchmarks: " print
|
||||
"../benchmarks" [ stdio get contents eval ] with-file-in benchmarks.
|
||||
|
||||
] with-file-out ;
|
||||
|
||||
: build ( -- )
|
||||
[ (build) ] [ drop ] recover
|
||||
"report" "../report" email-file ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: updates-available? ( -- ? )
|
||||
git-id
|
||||
|
|
|
|||
|
|
@ -1,28 +1,27 @@
|
|||
|
||||
USING: kernel sequences assocs builder continuations vocabs vocabs.loader
|
||||
USING: kernel namespaces sequences assocs builder continuations
|
||||
vocabs vocabs.loader
|
||||
io
|
||||
io.files
|
||||
prettyprint
|
||||
tools.browser
|
||||
tools.test ;
|
||||
tools.test
|
||||
bootstrap.stage2 benchmark ;
|
||||
|
||||
IN: builder.test
|
||||
|
||||
: try-everything* ( -- vocabs ) try-everything [ first vocab-link-name ] map ;
|
||||
|
||||
: do-load ( -- )
|
||||
[ try-everything* ] "../load-everything-time" log-runtime
|
||||
dup empty?
|
||||
[ drop ]
|
||||
[ "../load-everything-log" log-object ]
|
||||
if ;
|
||||
try-everything keys "../load-everything-vocabs" [ . ] with-file-out ;
|
||||
|
||||
: do-tests ( -- )
|
||||
run-all-tests keys
|
||||
dup empty?
|
||||
[ drop ]
|
||||
[ "../failing-tests" log-object ]
|
||||
if ;
|
||||
run-all-tests keys "../test-all-vocabs" [ . ] with-file-out ;
|
||||
|
||||
: do-all ( -- ) do-load do-tests ;
|
||||
: do-benchmarks ( -- ) run-benchmarks "../benchmarks" [ . ] with-file-out ;
|
||||
|
||||
: do-all ( -- )
|
||||
bootstrap-time get "../boot-time" [ . ] with-file-out
|
||||
[ do-load ] runtime "../load-time" [ . ] with-file-out
|
||||
[ do-tests ] runtime "../test-time" [ . ] with-file-out
|
||||
do-benchmarks ;
|
||||
|
||||
MAIN: do-all
|
||||
|
|
@ -1,6 +1,5 @@
|
|||
USING: arrays bunny.model combinators.lib continuations
|
||||
kernel multiline opengl opengl.shaders opengl.capabilities
|
||||
opengl.gl sequences ;
|
||||
USING: arrays bunny.model continuations kernel multiline opengl opengl.shaders
|
||||
opengl.capabilities opengl.gl sequences sequences.lib ;
|
||||
IN: bunny.cel-shaded
|
||||
|
||||
STRING: vertex-shader-source
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
USING: alien alien.c-types arrays sequences math
|
||||
math.vectors math.matrices math.parser io io.files kernel opengl
|
||||
opengl.gl opengl.glu opengl.capabilities shuffle http.client
|
||||
vectors splitting
|
||||
tools.time system combinators combinators.lib combinators.cleave
|
||||
float-arrays continuations namespaces ;
|
||||
USING: alien alien.c-types arrays sequences math math.vectors math.matrices
|
||||
math.parser io io.files kernel opengl opengl.gl opengl.glu
|
||||
opengl.capabilities shuffle http.client vectors splitting tools.time system
|
||||
combinators combinators.cleave float-arrays continuations namespaces
|
||||
sequences.lib ;
|
||||
IN: bunny.model
|
||||
|
||||
: numbers ( str -- seq )
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: combinators.lib kernel math math.ranges random sequences
|
||||
tools.test continuations arrays vectors ;
|
||||
USING: combinators.lib kernel math random sequences tools.test continuations
|
||||
arrays vectors ;
|
||||
IN: temporary
|
||||
|
||||
[ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.files io.launcher io.styles io hashtables kernel
|
||||
sequences combinators.lib assocs system sorting math.parser ;
|
||||
sequences sequences.lib assocs system sorting math.parser ;
|
||||
IN: contributors
|
||||
|
||||
: changelog ( -- authors )
|
||||
|
|
|
|||
|
|
@ -1,35 +1,45 @@
|
|||
! Copyright (C) 2006 Slava Pestov
|
||||
! Copyright (C) 2006, 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.syntax kernel math sequences ;
|
||||
IN: core-foundation
|
||||
|
||||
TYPEDEF: void* CFAllocatorRef
|
||||
TYPEDEF: void* CFArrayRef
|
||||
TYPEDEF: void* CFBundleRef
|
||||
TYPEDEF: void* CFStringRef
|
||||
TYPEDEF: void* CFURLRef
|
||||
TYPEDEF: void* CFUUIDRef
|
||||
TYPEDEF: void* CFRunLoopRef
|
||||
TYPEDEF: bool Boolean
|
||||
TYPEDEF: int CFIndex
|
||||
TYPEDEF: double CFTimeInterval
|
||||
TYPEDEF: double CFAbsoluteTime
|
||||
|
||||
FUNCTION: void* CFArrayCreateMutable ( void* allocator, CFIndex capacity, void* callbacks ) ;
|
||||
FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ;
|
||||
|
||||
FUNCTION: void* CFArrayGetValueAtIndex ( void* array, CFIndex idx ) ;
|
||||
FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ;
|
||||
|
||||
FUNCTION: void CFArraySetValueAtIndex ( void* array, CFIndex index, void* value ) ;
|
||||
FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* value ) ;
|
||||
|
||||
FUNCTION: CFIndex CFArrayGetCount ( void* array ) ;
|
||||
FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ;
|
||||
|
||||
: kCFURLPOSIXPathStyle 0 ;
|
||||
|
||||
FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ;
|
||||
FUNCTION: CFURLRef CFURLCreateWithFileSystemPath ( CFAllocatorRef allocator, CFStringRef filePath, int pathStyle, Boolean isDirectory ) ;
|
||||
|
||||
FUNCTION: void* CFURLCreateWithString ( void* allocator, void* string, void* base ) ;
|
||||
FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef string, CFURLRef base ) ;
|
||||
|
||||
FUNCTION: void* CFURLCopyFileSystemPath ( void* url, int pathStyle ) ;
|
||||
FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
|
||||
|
||||
FUNCTION: void* CFStringCreateWithCharacters ( void* allocator, ushort* cStr, CFIndex numChars ) ;
|
||||
FUNCTION: CFStringRef CFStringCreateWithCharacters ( CFAllocatorRef allocator, ushort* cStr, CFIndex numChars ) ;
|
||||
|
||||
FUNCTION: CFIndex CFStringGetLength ( void* theString ) ;
|
||||
FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
|
||||
|
||||
FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
|
||||
|
||||
FUNCTION: void* CFBundleCreate ( void* allocator, void* bundleURL ) ;
|
||||
FUNCTION: CFBundleRef CFBundleCreate ( CFAllocatorRef allocator, CFURLRef bundleURL ) ;
|
||||
|
||||
FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ;
|
||||
FUNCTION: Boolean CFBundleLoadExecutable ( CFBundleRef bundle ) ;
|
||||
|
||||
FUNCTION: void CFRelease ( void* cf ) ;
|
||||
|
||||
|
|
@ -52,6 +62,9 @@ FUNCTION: void CFRelease ( void* cf ) ;
|
|||
: CF>string-array ( alien -- seq )
|
||||
CF>array [ CF>string ] map ;
|
||||
|
||||
: <CFStringArray> ( seq -- alien )
|
||||
[ <CFString> ] map dup <CFArray> swap [ CFRelease ] each ;
|
||||
|
||||
: <CFFileSystemURL> ( string dir? -- url )
|
||||
>r <CFString> f over kCFURLPOSIXPathStyle
|
||||
r> CFURLCreateWithFileSystemPath swap CFRelease ;
|
||||
|
|
@ -72,3 +85,5 @@ FUNCTION: void CFRelease ( void* cf ) ;
|
|||
] [
|
||||
"Cannot load bundled named " swap append throw
|
||||
] ?if ;
|
||||
|
||||
FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,203 @@
|
|||
! Copyright (C) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.syntax kernel math sequences
|
||||
namespaces assocs init continuations core-foundation ;
|
||||
IN: core-foundation.fsevents
|
||||
|
||||
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
|
||||
! FSEventStream API, Leopard only !
|
||||
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
|
||||
|
||||
: kFSEventStreamCreateFlagUseCFTypes 2 ; inline
|
||||
: kFSEventStreamCreateFlagWatchRoot 4 ; inline
|
||||
|
||||
: kFSEventStreamEventFlagMustScanSubDirs 1 ; inline
|
||||
: kFSEventStreamEventFlagUserDropped 2 ; inline
|
||||
: kFSEventStreamEventFlagKernelDropped 4 ; inline
|
||||
: kFSEventStreamEventFlagEventIdsWrapped 8 ; inline
|
||||
: kFSEventStreamEventFlagHistoryDone 16 ; inline
|
||||
: kFSEventStreamEventFlagRootChanged 32 ; inline
|
||||
: kFSEventStreamEventFlagMount 64 ; inline
|
||||
: kFSEventStreamEventFlagUnmount 128 ; inline
|
||||
|
||||
TYPEDEF: int FSEventStreamCreateFlags
|
||||
TYPEDEF: int FSEventStreamEventFlags
|
||||
TYPEDEF: longlong FSEventStreamEventId
|
||||
TYPEDEF: void* FSEventStreamRef
|
||||
|
||||
C-STRUCT: FSEventStreamContext
|
||||
{ "CFIndex" "version" }
|
||||
{ "void*" "info" }
|
||||
{ "void*" "retain" }
|
||||
{ "void*" "release" }
|
||||
{ "void*" "copyDescription" } ;
|
||||
|
||||
! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]);
|
||||
TYPEDEF: void* FSEventStreamCallback
|
||||
|
||||
: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF ; inline
|
||||
|
||||
FUNCTION: FSEventStreamRef FSEventStreamCreate (
|
||||
CFAllocatorRef allocator,
|
||||
FSEventStreamCallback callback,
|
||||
FSEventStreamContext* context,
|
||||
CFArrayRef pathsToWatch,
|
||||
FSEventStreamEventId sinceWhen,
|
||||
CFTimeInterval latency,
|
||||
FSEventStreamCreateFlags flags ) ;
|
||||
|
||||
FUNCTION: FSEventStreamRef FSEventStreamCreateRelativeToDevice (
|
||||
CFAllocatorRef allocator,
|
||||
FSEventStreamCallback callback,
|
||||
FSEventStreamContext* context,
|
||||
dev_t deviceToWatch,
|
||||
CFArrayRef pathsToWatchRelativeToDevice,
|
||||
FSEventStreamEventId sinceWhen,
|
||||
CFTimeInterval latency,
|
||||
FSEventStreamCreateFlags flags ) ;
|
||||
|
||||
FUNCTION: FSEventStreamEventId FSEventStreamGetLatestEventId ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: dev_t FSEventStreamGetDeviceBeingWatched ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: CFArrayRef FSEventStreamCopyPathsBeingWatched ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: FSEventStreamEventId FSEventsGetCurrentEventId ( ) ;
|
||||
|
||||
FUNCTION: CFUUIDRef FSEventsCopyUUIDForDevice ( dev_t dev ) ;
|
||||
|
||||
FUNCTION: FSEventStreamEventId FSEventsGetLastEventIdForDeviceBeforeTime (
|
||||
dev_t dev,
|
||||
CFAbsoluteTime time ) ;
|
||||
|
||||
FUNCTION: Boolean FSEventsPurgeEventsForDeviceUpToEventId (
|
||||
dev_t dev,
|
||||
FSEventStreamEventId eventId ) ;
|
||||
|
||||
FUNCTION: void FSEventStreamRetain ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: void FSEventStreamRelease ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: void FSEventStreamScheduleWithRunLoop (
|
||||
FSEventStreamRef streamRef,
|
||||
CFRunLoopRef runLoop,
|
||||
CFStringRef runLoopMode ) ;
|
||||
|
||||
FUNCTION: void FSEventStreamUnscheduleFromRunLoop (
|
||||
FSEventStreamRef streamRef,
|
||||
CFRunLoopRef runLoop,
|
||||
CFStringRef runLoopMode ) ;
|
||||
|
||||
FUNCTION: void FSEventStreamInvalidate ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: Boolean FSEventStreamStart ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: FSEventStreamEventId FSEventStreamFlushAsync ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: void FSEventStreamFlushSync ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: void FSEventStreamStop ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: void FSEventStreamShow ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
: make-FSEventStreamContext ( info -- alien )
|
||||
"FSEventStreamContext" <c-object>
|
||||
[ set-FSEventStreamContext-info ] keep ;
|
||||
|
||||
: <FSEventStream> ( callback info paths latency flags -- event-stream )
|
||||
>r >r >r >r >r
|
||||
f ! allocator
|
||||
r> ! callback
|
||||
r> make-FSEventStreamContext
|
||||
r> <CFStringArray> ! paths
|
||||
FSEventStreamEventIdSinceNow ! sinceWhen
|
||||
r> ! latency
|
||||
r> ! flags
|
||||
FSEventStreamCreate ;
|
||||
|
||||
: kCFRunLoopCommonModes ( -- string )
|
||||
"kCFRunLoopCommonModes" f dlsym *void* ;
|
||||
|
||||
: schedule-event-stream ( event-stream -- )
|
||||
CFRunLoopGetMain
|
||||
kCFRunLoopCommonModes
|
||||
FSEventStreamScheduleWithRunLoop ;
|
||||
|
||||
: unschedule-event-stream ( event-stream -- )
|
||||
CFRunLoopGetMain
|
||||
kCFRunLoopCommonModes
|
||||
FSEventStreamUnscheduleFromRunLoop ;
|
||||
|
||||
: enable-event-stream ( event-stream -- )
|
||||
dup
|
||||
schedule-event-stream
|
||||
dup FSEventStreamStart [
|
||||
drop
|
||||
] [
|
||||
dup unschedule-event-stream
|
||||
FSEventStreamRelease
|
||||
"Cannot enable FSEventStream" throw
|
||||
] if ;
|
||||
|
||||
: disable-event-stream ( event-stream -- )
|
||||
dup FSEventStreamStop
|
||||
unschedule-event-stream ;
|
||||
|
||||
SYMBOL: event-stream-callbacks
|
||||
|
||||
: event-stream-counter \ event-stream-counter counter ;
|
||||
|
||||
[
|
||||
H{ } clone event-stream-callbacks set-global
|
||||
1 \ event-stream-counter set-global
|
||||
] "core-foundation" add-init-hook
|
||||
|
||||
event-stream-callbacks global [ H{ } assoc-like ] change-at
|
||||
|
||||
: add-event-source-callback ( quot -- id )
|
||||
event-stream-counter <alien>
|
||||
[ event-stream-callbacks get set-at ] keep ;
|
||||
|
||||
: remove-event-source-callback ( id -- )
|
||||
event-stream-callbacks get delete-at ;
|
||||
|
||||
: >event-triple ( n eventPaths eventFlags eventIds -- triple )
|
||||
[
|
||||
>r >r >r dup dup
|
||||
r> char*-nth ,
|
||||
r> int-nth ,
|
||||
r> longlong-nth ,
|
||||
] { } make ;
|
||||
|
||||
: master-event-source-callback ( -- alien )
|
||||
"void"
|
||||
{
|
||||
"FSEventStreamRef"
|
||||
"void*" ! info
|
||||
"size_t" ! numEvents
|
||||
"void*" ! eventPaths
|
||||
"FSEventStreamEventFlags*"
|
||||
"FSEventStreamEventId*"
|
||||
}
|
||||
"cdecl" [
|
||||
[ >event-triple ] 3curry map
|
||||
swap event-stream-callbacks get at call
|
||||
drop
|
||||
] alien-callback ;
|
||||
|
||||
TUPLE: event-stream info handle ;
|
||||
|
||||
: <event-stream> ( quot paths latency flags -- event-stream )
|
||||
>r >r >r
|
||||
add-event-source-callback dup
|
||||
>r master-event-source-callback r>
|
||||
r> r> r> <FSEventStream>
|
||||
dup enable-event-stream
|
||||
event-stream construct-boa ;
|
||||
|
||||
M: event-stream dispose
|
||||
dup event-stream-info remove-event-source-callback
|
||||
event-stream-handle dup disable-event-stream
|
||||
FSEventStreamRelease ;
|
||||
|
|
@ -15,7 +15,8 @@ TUPLE: db handle insert-statements update-statements delete-statements select-st
|
|||
GENERIC: db-open ( db -- )
|
||||
HOOK: db-close db ( handle -- )
|
||||
|
||||
: dispose-statements [ dispose drop ] assoc-each ;
|
||||
: dispose-statements ( seq -- )
|
||||
[ dispose drop ] assoc-each ;
|
||||
|
||||
: dispose-db ( db -- )
|
||||
dup db [
|
||||
|
|
@ -27,39 +28,36 @@ HOOK: db-close db ( handle -- )
|
|||
] with-variable ;
|
||||
|
||||
TUPLE: statement sql params handle bound? ;
|
||||
|
||||
TUPLE: simple-statement ;
|
||||
TUPLE: prepared-statement ;
|
||||
|
||||
HOOK: <simple-statement> db ( str -- statement )
|
||||
HOOK: <prepared-statement> db ( str -- statement )
|
||||
|
||||
GENERIC: prepare-statement ( statement -- )
|
||||
GENERIC: bind-statement* ( obj statement -- )
|
||||
GENERIC: rebind-statement ( obj statement -- )
|
||||
GENERIC: reset-statement ( statement -- )
|
||||
GENERIC: execute-statement* ( statement -- result-set )
|
||||
HOOK: last-id db ( res -- id )
|
||||
: execute-statement ( statement -- )
|
||||
execute-statement* dispose ;
|
||||
|
||||
GENERIC: execute-statement ( statement -- )
|
||||
: execute-statement-last-id ( statement -- id )
|
||||
execute-statement* [ last-id ] with-disposal ;
|
||||
|
||||
: bind-statement ( obj statement -- )
|
||||
2dup dup statement-bound? [
|
||||
rebind-statement
|
||||
] [
|
||||
bind-statement*
|
||||
] if
|
||||
tuck set-statement-params
|
||||
dup statement-bound? [ dup reset-statement ] when
|
||||
[ bind-statement* ] 2keep
|
||||
[ set-statement-params ] keep
|
||||
t swap set-statement-bound? ;
|
||||
|
||||
TUPLE: result-set sql params handle n max ;
|
||||
|
||||
GENERIC: query-results ( query -- result-set )
|
||||
|
||||
GENERIC: #rows ( result-set -- n )
|
||||
GENERIC: #columns ( result-set -- n )
|
||||
GENERIC# row-column 1 ( result-set n -- obj )
|
||||
GENERIC: advance-row ( result-set -- ? )
|
||||
|
||||
HOOK: last-id db ( -- id )
|
||||
|
||||
: init-result-set ( result-set -- )
|
||||
dup #rows over set-result-set-max
|
||||
-1 swap set-result-set-n ;
|
||||
|
|
|
|||
|
|
@ -1,17 +1,14 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! Copyright (C) 2007, 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
! tested on debian linux with postgresql 8.1
|
||||
|
||||
USING: alien alien.syntax combinators system ;
|
||||
IN: db.postgresql.ffi
|
||||
|
||||
<<
|
||||
"postgresql" {
|
||||
<< "postgresql" {
|
||||
{ [ win32? ] [ "libpq.dll" ] }
|
||||
{ [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] }
|
||||
{ [ unix? ] [ "libpq.so" ] }
|
||||
} cond "cdecl" add-library
|
||||
>>
|
||||
} cond "cdecl" add-library >>
|
||||
|
||||
! ConnSatusType
|
||||
: CONNECTION_OK HEX: 0 ; inline
|
||||
|
|
@ -53,6 +50,8 @@ IN: db.postgresql.ffi
|
|||
: PQERRORS_DEFAULT HEX: 1 ; inline
|
||||
: PQERRORS_VERBOSE HEX: 2 ; inline
|
||||
|
||||
: InvalidOid 0 ; inline
|
||||
|
||||
TYPEDEF: int size_t
|
||||
TYPEDEF: int ConnStatusType
|
||||
TYPEDEF: int ExecStatusType
|
||||
|
|
@ -75,7 +74,6 @@ TYPEDEF: void* SSL*
|
|||
|
||||
LIBRARY: postgresql
|
||||
|
||||
|
||||
! Exported functions of libpq
|
||||
|
||||
! make a new client connection to the backend
|
||||
|
|
@ -102,10 +100,6 @@ FUNCTION: PQconninfoOption* PQconndefaults ( ) ;
|
|||
! free the data structure returned by PQconndefaults()
|
||||
FUNCTION: void PQconninfoFree ( PQconninfoOption* connOptions ) ;
|
||||
|
||||
!
|
||||
! close the current connection and restablish a new one with the same
|
||||
! parameters
|
||||
!
|
||||
! Asynchronous (non-blocking)
|
||||
FUNCTION: int PQresetStart ( PGconn* conn ) ;
|
||||
FUNCTION: PostgresPollingStatusType PQresetPoll ( PGconn* conn ) ;
|
||||
|
|
|
|||
|
|
@ -37,8 +37,13 @@ IN: db.postgresql.lib
|
|||
>r db get db-handle r>
|
||||
[ statement-sql ] keep
|
||||
[ statement-params length f ] keep
|
||||
statement-params [ malloc-char-string ] map >c-void*-array
|
||||
statement-params [ second malloc-char-string ] map >c-void*-array
|
||||
f f 0 PQexecParams
|
||||
dup postgresql-result-ok? [
|
||||
dup postgresql-result-error-message swap PQclear throw
|
||||
] unless ;
|
||||
|
||||
: pq-oid-value ( res -- n )
|
||||
PQoidValue dup InvalidOid = [
|
||||
"postgresql returned an InvalidOid" throw
|
||||
] when ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
! Copyright (C) 2007, 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs alien alien.syntax continuations io
|
||||
kernel math namespaces prettyprint quotations
|
||||
sequences debugger db db.postgresql.lib db.postgresql.ffi ;
|
||||
kernel math math.parser namespaces prettyprint quotations
|
||||
sequences debugger db db.postgresql.lib db.postgresql.ffi
|
||||
db.tuples db.types ;
|
||||
IN: db.postgresql
|
||||
|
||||
TUPLE: postgresql-db host port pgopts pgtty db user pass ;
|
||||
|
|
@ -39,8 +40,8 @@ M: postgresql-db dispose ( db -- )
|
|||
M: postgresql-statement bind-statement* ( seq statement -- )
|
||||
set-statement-params ;
|
||||
|
||||
M: postgresql-statement rebind-statement ( seq statement -- )
|
||||
bind-statement* ;
|
||||
M: postgresql-statement reset-statement ( statement -- )
|
||||
drop ;
|
||||
|
||||
M: postgresql-result-set #rows ( result-set -- n )
|
||||
result-set-handle PQntuples ;
|
||||
|
|
@ -51,8 +52,8 @@ M: postgresql-result-set #columns ( result-set -- n )
|
|||
M: postgresql-result-set row-column ( result-set n -- obj )
|
||||
>r dup result-set-handle swap result-set-n r> PQgetvalue ;
|
||||
|
||||
M: postgresql-statement execute-statement ( statement -- )
|
||||
query-results dispose ;
|
||||
M: postgresql-statement execute-statement* ( statement -- obj )
|
||||
query-results ;
|
||||
|
||||
: increment-n ( result-set -- n )
|
||||
dup result-set-n 1+ dup rot set-result-set-n ;
|
||||
|
|
@ -103,3 +104,103 @@ M: postgresql-db commit-transaction ( -- )
|
|||
|
||||
M: postgresql-db rollback-transaction ( -- )
|
||||
"ROLLBACK" sql-command ;
|
||||
|
||||
|
||||
M: postgresql-db create-sql ( columns table -- sql )
|
||||
[
|
||||
"create table " % %
|
||||
" (" % [ ", " % ] [
|
||||
dup second % " " %
|
||||
dup third >sql-type % " " %
|
||||
sql-modifiers " " join %
|
||||
] interleave ")" %
|
||||
] "" make ;
|
||||
|
||||
M: postgresql-db drop-sql ( table -- sql )
|
||||
[
|
||||
"drop table " % %
|
||||
] "" make ;
|
||||
|
||||
SYMBOL: postgresql-counter
|
||||
|
||||
M: postgresql-db insert-sql* ( columns table -- sql )
|
||||
[
|
||||
postgresql-counter off
|
||||
"insert into " %
|
||||
%
|
||||
"(" %
|
||||
dup [ ", " % ] [ second % ] interleave
|
||||
") " %
|
||||
" values (" %
|
||||
[ ", " % ] [
|
||||
drop "$" % postgresql-counter [ inc ] keep get #
|
||||
] interleave
|
||||
")" %
|
||||
] "" make ;
|
||||
|
||||
M: postgresql-db update-sql* ( columns table -- sql )
|
||||
[
|
||||
"update " %
|
||||
%
|
||||
" set " %
|
||||
dup remove-id
|
||||
[ ", " % ] [ second dup % " = :" % % ] interleave
|
||||
" where " %
|
||||
[ primary-key? ] find nip second dup % " = :" % %
|
||||
] "" make ;
|
||||
|
||||
M: postgresql-db delete-sql* ( columns table -- sql )
|
||||
[
|
||||
"delete from " %
|
||||
%
|
||||
" where " %
|
||||
first second dup % " = :" % %
|
||||
] "" make ;
|
||||
|
||||
M: postgresql-db select-sql* ( columns table -- sql )
|
||||
drop ;
|
||||
|
||||
M: postgresql-db tuple>params ( columns tuple -- obj )
|
||||
[
|
||||
>r dup first r> get-slot-named swap third
|
||||
] curry { } map>assoc ;
|
||||
|
||||
M: postgresql-db last-id ( res -- id )
|
||||
pq-oid-value ;
|
||||
|
||||
: postgresql-db-modifiers ( -- hashtable )
|
||||
H{
|
||||
{ +native-id+ "primary key" }
|
||||
{ +assigned-id+ "primary key" }
|
||||
{ +autoincrement+ "autoincrement" }
|
||||
{ +unique+ "unique" }
|
||||
{ +default+ "default" }
|
||||
{ +null+ "null" }
|
||||
{ +not-null+ "not null" }
|
||||
} ;
|
||||
|
||||
M: postgresql-db sql-modifiers* ( modifiers -- str )
|
||||
postgresql-db-modifiers swap [
|
||||
dup array? [
|
||||
first2
|
||||
>r swap at r> number>string*
|
||||
" " swap 3append
|
||||
] [
|
||||
swap at
|
||||
] if
|
||||
] with map [ ] subset ;
|
||||
|
||||
: postgresql-type-hash ( -- assoc )
|
||||
H{
|
||||
{ INTEGER "integer" }
|
||||
{ TEXT "text" }
|
||||
{ VARCHAR "text" }
|
||||
{ DOUBLE "real" }
|
||||
} ;
|
||||
|
||||
M: postgresql-db >sql-type ( obj -- str )
|
||||
dup pair? [
|
||||
first >sql-type
|
||||
] [
|
||||
postgresql-type-hash at* [ T{ no-sql-type } throw ] unless
|
||||
] if ;
|
||||
|
|
|
|||
|
|
@ -1,17 +1,12 @@
|
|||
! Copyright (C) 2005 Chris Double, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! An interface to the sqlite database. Tested against sqlite v3.1.3.
|
||||
|
||||
! Not all functions have been wrapped yet. Only those directly involving
|
||||
! executing SQL calls and obtaining results.
|
||||
|
||||
! Not all functions have been wrapped.
|
||||
USING: alien compiler kernel math namespaces sequences strings alien.syntax
|
||||
system combinators ;
|
||||
IN: db.sqlite.ffi
|
||||
|
||||
<<
|
||||
"sqlite" {
|
||||
<< "sqlite" {
|
||||
{ [ winnt? ] [ "sqlite3.dll" ] }
|
||||
{ [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
|
||||
{ [ unix? ] [ "libsqlite3.so" ] }
|
||||
|
|
@ -76,8 +71,9 @@ IN: db.sqlite.ffi
|
|||
"File opened that is not a database file"
|
||||
} ;
|
||||
|
||||
: SQLITE_ROW 100 ; inline ! sqlite_step() has another row ready
|
||||
: SQLITE_DONE 101 ; inline ! sqlite_step() has finished executing
|
||||
! Return values from sqlite3_step
|
||||
: SQLITE_ROW 100 ; inline
|
||||
: SQLITE_DONE 101 ; inline
|
||||
|
||||
! Return values from the sqlite3_column_type function
|
||||
: SQLITE_INTEGER 1 ; inline
|
||||
|
|
@ -103,7 +99,6 @@ IN: db.sqlite.ffi
|
|||
: SQLITE_OPEN_SUBJOURNAL HEX: 00002000 ; inline
|
||||
: SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000 ; inline
|
||||
|
||||
|
||||
TYPEDEF: void sqlite3
|
||||
TYPEDEF: void sqlite3_stmt
|
||||
TYPEDEF: longlong sqlite3_int64
|
||||
|
|
@ -112,6 +107,7 @@ TYPEDEF: ulonglong sqlite3_uint64
|
|||
LIBRARY: sqlite
|
||||
FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
|
||||
FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
|
||||
FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
|
||||
FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
|
||||
FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ;
|
||||
FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ;
|
||||
|
|
|
|||
|
|
@ -1,18 +1,25 @@
|
|||
! Copyright (C) 2008 Chris Double, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types assocs kernel math math.parser sequences
|
||||
db.sqlite.ffi ;
|
||||
USING: alien.c-types arrays assocs kernel math math.parser
|
||||
namespaces sequences db.sqlite.ffi db combinators
|
||||
continuations db.types ;
|
||||
IN: db.sqlite.lib
|
||||
|
||||
TUPLE: sqlite-error n message ;
|
||||
: sqlite-error ( n -- * )
|
||||
sqlite-error-messages nth throw ;
|
||||
|
||||
: sqlite-check-result ( result -- )
|
||||
dup SQLITE_OK = [
|
||||
drop
|
||||
] [
|
||||
dup sqlite-error-messages nth
|
||||
sqlite-error construct-boa throw
|
||||
] if ;
|
||||
: sqlite-statement-error-string ( -- str )
|
||||
db get db-handle sqlite3_errmsg ;
|
||||
|
||||
: sqlite-statement-error ( -- * )
|
||||
sqlite-statement-error-string throw ;
|
||||
|
||||
: sqlite-check-result ( n -- )
|
||||
{
|
||||
{ [ dup SQLITE_OK = ] [ drop ] }
|
||||
{ [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] }
|
||||
{ [ t ] [ sqlite-error ] }
|
||||
} cond ;
|
||||
|
||||
: sqlite-open ( filename -- db )
|
||||
"void*" <c-object>
|
||||
|
|
@ -21,61 +28,83 @@ TUPLE: sqlite-error n message ;
|
|||
: sqlite-close ( db -- )
|
||||
sqlite3_close sqlite-check-result ;
|
||||
|
||||
: sqlite-prepare ( db sql -- statement )
|
||||
#! TODO: Support multiple statements in the SQL string.
|
||||
: sqlite-prepare ( db sql -- handle )
|
||||
dup length "void*" <c-object> "void*" <c-object>
|
||||
[ sqlite3_prepare sqlite-check-result ] 2keep
|
||||
drop *void* ;
|
||||
|
||||
: sqlite-bind-text ( statement index text -- )
|
||||
dup number? [ number>string ] when
|
||||
dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-parameter-index ( statement name -- index )
|
||||
: sqlite-bind-parameter-index ( handle name -- index )
|
||||
sqlite3_bind_parameter_index ;
|
||||
|
||||
: sqlite-bind-text-by-name ( statement name text -- )
|
||||
>r dupd sqlite-bind-parameter-index r> sqlite-bind-text ;
|
||||
: parameter-index ( handle name text -- handle name text )
|
||||
>r dupd sqlite-bind-parameter-index r> ;
|
||||
|
||||
: sqlite-bind-assoc ( statement assoc -- )
|
||||
swap [
|
||||
-rot sqlite-bind-text-by-name
|
||||
] curry assoc-each ;
|
||||
: sqlite-bind-text ( handle index text -- )
|
||||
dup length SQLITE_TRANSIENT
|
||||
sqlite3_bind_text sqlite-check-result ;
|
||||
|
||||
: sqlite-finalize ( statement -- )
|
||||
: sqlite-bind-int ( handle i n -- )
|
||||
sqlite3_bind_int sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-int64 ( handle i n -- )
|
||||
sqlite3_bind_int64 sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-double ( handle i x -- )
|
||||
sqlite3_bind_double sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-null ( handle i -- )
|
||||
sqlite3_bind_null sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-text-by-name ( handle name text -- )
|
||||
parameter-index sqlite-bind-text ;
|
||||
|
||||
: sqlite-bind-int-by-name ( handle name int -- )
|
||||
parameter-index sqlite-bind-int ;
|
||||
|
||||
: sqlite-bind-int64-by-name ( handle name int64 -- )
|
||||
parameter-index sqlite-bind-int ;
|
||||
|
||||
: sqlite-bind-double-by-name ( handle name double -- )
|
||||
parameter-index sqlite-bind-double ;
|
||||
|
||||
: sqlite-bind-null-by-name ( handle name obj -- )
|
||||
parameter-index drop sqlite-bind-null ;
|
||||
|
||||
: sqlite-bind-type ( handle key value type -- )
|
||||
dup array? [ first ] when
|
||||
{
|
||||
{ INTEGER [ sqlite-bind-int-by-name ] }
|
||||
{ BIG_INTEGER [ sqlite-bind-int-by-name ] }
|
||||
{ TEXT [ sqlite-bind-text-by-name ] }
|
||||
{ VARCHAR [ sqlite-bind-text-by-name ] }
|
||||
{ DOUBLE [ sqlite-bind-double-by-name ] }
|
||||
! { NULL [ sqlite-bind-null-by-name ] }
|
||||
[ no-sql-type ]
|
||||
} case ;
|
||||
|
||||
: sqlite-finalize ( handle -- )
|
||||
sqlite3_finalize sqlite-check-result ;
|
||||
|
||||
: sqlite-reset ( statement -- )
|
||||
: sqlite-reset ( handle -- )
|
||||
sqlite3_reset sqlite-check-result ;
|
||||
|
||||
: sqlite-#columns ( query -- int )
|
||||
sqlite3_column_count ;
|
||||
|
||||
: sqlite-column ( statement index -- string )
|
||||
! TODO
|
||||
: sqlite-column ( handle index -- string )
|
||||
sqlite3_column_text ;
|
||||
|
||||
: sqlite-row ( statement -- seq )
|
||||
! TODO
|
||||
: sqlite-row ( handle -- seq )
|
||||
dup sqlite-#columns [ sqlite-column ] with map ;
|
||||
|
||||
! 2dup sqlite3_column_type .
|
||||
! SQLITE_INTEGER 1
|
||||
! SQLITE_FLOAT 2
|
||||
! SQLITE_TEXT 3
|
||||
! SQLITE_BLOB 4
|
||||
! SQLITE_NULL 5
|
||||
|
||||
: step-complete? ( step-result -- bool )
|
||||
dup SQLITE_ROW = [
|
||||
drop f
|
||||
] [
|
||||
dup SQLITE_DONE = [ drop t ] [ sqlite-check-result t ] if
|
||||
] if ;
|
||||
|
||||
: sqlite-step ( prepared -- )
|
||||
dup sqlite3_step step-complete? [
|
||||
drop
|
||||
] [
|
||||
sqlite-step
|
||||
dup SQLITE_DONE =
|
||||
[ drop ] [ sqlite-check-result ] if t
|
||||
] if ;
|
||||
|
||||
: sqlite-next ( prepared -- ? )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: io io.files io.launcher kernel namespaces
|
||||
prettyprint tools.test db.sqlite db sequences
|
||||
continuations ;
|
||||
continuations db.types ;
|
||||
IN: temporary
|
||||
|
||||
: test.db "extra/db/sqlite/test.db" resource-path ;
|
||||
|
|
@ -26,13 +26,13 @@ IN: temporary
|
|||
test.db [
|
||||
"select * from person where name = :name and country = :country"
|
||||
<simple-statement> [
|
||||
{ { ":name" "Jane" } { ":country" "New Zealand" } }
|
||||
{ { ":name" "Jane" TEXT } { ":country" "New Zealand" TEXT } }
|
||||
over do-bound-query
|
||||
|
||||
{ { "Jane" "New Zealand" } } =
|
||||
[ "test fails" throw ] unless
|
||||
|
||||
{ { ":name" "John" } { ":country" "America" } }
|
||||
{ { ":name" "John" TEXT } { ":country" "America" TEXT } }
|
||||
swap do-bound-query
|
||||
] with-disposal
|
||||
] with-sqlite
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ M: sqlite-db dispose ( db -- ) dispose-db ;
|
|||
TUPLE: sqlite-statement ;
|
||||
C: <sqlite-statement> sqlite-statement
|
||||
|
||||
TUPLE: sqlite-result-set ;
|
||||
TUPLE: sqlite-result-set advanced? ;
|
||||
: <sqlite-result-set> ( query -- sqlite-result-set )
|
||||
dup statement-handle sqlite-result-set <result-set> ;
|
||||
|
||||
|
|
@ -40,18 +40,26 @@ M: sqlite-db <prepared-statement> ( str -- obj )
|
|||
M: sqlite-statement dispose ( statement -- )
|
||||
statement-handle sqlite-finalize ;
|
||||
|
||||
: maybe-advance-row ( result-set -- result-set )
|
||||
dup sqlite-result-set-advanced? [
|
||||
dup advance-row drop
|
||||
] unless ;
|
||||
|
||||
M: sqlite-result-set dispose ( result-set -- )
|
||||
maybe-advance-row
|
||||
f swap set-result-set-handle ;
|
||||
|
||||
M: sqlite-statement bind-statement* ( assoc statement -- )
|
||||
statement-handle swap sqlite-bind-assoc ;
|
||||
: sqlite-bind ( triples handle -- )
|
||||
swap [ first3 sqlite-bind-type ] with each ;
|
||||
|
||||
M: sqlite-statement rebind-statement ( assoc statement -- )
|
||||
dup statement-handle sqlite-reset
|
||||
statement-handle swap sqlite-bind-assoc ;
|
||||
M: sqlite-statement bind-statement* ( triples statement -- )
|
||||
statement-handle sqlite-bind ;
|
||||
|
||||
M: sqlite-statement execute-statement ( statement -- )
|
||||
statement-handle sqlite-next drop ;
|
||||
M: sqlite-statement reset-statement ( statement -- )
|
||||
statement-handle sqlite-reset ;
|
||||
|
||||
M: sqlite-statement execute-statement* ( statement -- obj )
|
||||
query-results ;
|
||||
|
||||
M: sqlite-result-set #columns ( result-set -- n )
|
||||
result-set-handle sqlite-#columns ;
|
||||
|
|
@ -60,7 +68,8 @@ M: sqlite-result-set row-column ( result-set n -- obj )
|
|||
>r result-set-handle r> sqlite-column ;
|
||||
|
||||
M: sqlite-result-set advance-row ( result-set -- handle ? )
|
||||
result-set-handle sqlite-next ;
|
||||
[ result-set-handle sqlite-next ] keep
|
||||
t swap set-sqlite-result-set-advanced? ;
|
||||
|
||||
M: sqlite-statement query-results ( query -- result-set )
|
||||
dup statement-handle sqlite-result-set <result-set> ;
|
||||
|
|
@ -118,7 +127,7 @@ M: sqlite-db delete-sql* ( columns table -- sql )
|
|||
%
|
||||
" where " %
|
||||
first second dup % " = :" % %
|
||||
] "" make dup . ;
|
||||
] "" make ;
|
||||
|
||||
M: sqlite-db select-sql* ( columns table -- sql )
|
||||
[
|
||||
|
|
@ -131,13 +140,15 @@ M: sqlite-db select-sql* ( columns table -- sql )
|
|||
|
||||
M: sqlite-db tuple>params ( columns tuple -- obj )
|
||||
[
|
||||
>r [ second ":" swap append ] keep first r> get-slot-named
|
||||
number>string*
|
||||
] curry { } map>assoc ;
|
||||
>r [ second ":" swap append ] keep r>
|
||||
dupd >r first r> get-slot-named swap
|
||||
third 3array
|
||||
] curry map ;
|
||||
|
||||
M: sqlite-db last-id ( -- id )
|
||||
db get db-handle sqlite3_last_insert_rowid ;
|
||||
|
||||
M: sqlite-db last-id ( result-set -- id )
|
||||
maybe-advance-row drop
|
||||
db get db-handle sqlite3_last_insert_rowid
|
||||
dup zero? [ "last-id failed" throw ] when ;
|
||||
|
||||
: sqlite-db-modifiers ( -- hashtable )
|
||||
H{
|
||||
|
|
@ -166,6 +177,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str )
|
|||
{ INTEGER "integer" }
|
||||
{ TEXT "text" }
|
||||
{ VARCHAR "text" }
|
||||
{ DOUBLE "real" }
|
||||
} ;
|
||||
|
||||
M: sqlite-db >sql-type ( obj -- str )
|
||||
|
|
|
|||
|
|
@ -1,26 +1,26 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.files kernel tools.test db db.sqlite db.tuples
|
||||
db.types continuations namespaces ;
|
||||
db.types continuations namespaces db.postgresql math
|
||||
tools.time ;
|
||||
IN: temporary
|
||||
|
||||
TUPLE: person the-id the-name the-number ;
|
||||
: <person> ( name age -- person )
|
||||
{ set-person-the-name set-person-the-number } person construct ;
|
||||
|
||||
person "PERSON"
|
||||
{
|
||||
{ "the-id" "ROWID" INTEGER +native-id+ }
|
||||
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ }
|
||||
{ "the-number" "AGE" INTEGER { +default+ 0 } }
|
||||
} define-persistent
|
||||
TUPLE: person the-id the-name the-number real ;
|
||||
: <person> ( name age real -- person )
|
||||
{
|
||||
set-person-the-name
|
||||
set-person-the-number
|
||||
set-person-real
|
||||
} person construct ;
|
||||
|
||||
: <assigned-person> ( id name number real -- obj )
|
||||
<person> [ set-person-the-id ] keep ;
|
||||
|
||||
SYMBOL: the-person
|
||||
|
||||
: test-tuples ( -- )
|
||||
[ person drop-table ] [ ] recover
|
||||
person create-table
|
||||
f "billy" 100 person construct-boa
|
||||
the-person set
|
||||
[ person drop-table ] [ drop ] recover
|
||||
[ ] [ person create-table ] unit-test
|
||||
|
||||
[ ] [ the-person get insert-tuple ] unit-test
|
||||
|
||||
|
|
@ -37,9 +37,33 @@ SYMBOL: the-person
|
|||
test-tuples
|
||||
] with-db ;
|
||||
|
||||
test-sqlite
|
||||
: test-postgresql ( -- )
|
||||
"localhost" "postgres" "" "factor-test" <postgresql-db> [
|
||||
test-tuples
|
||||
] with-db ;
|
||||
|
||||
! : test-postgres ( -- )
|
||||
! resource-path <postgresql-db> [
|
||||
! test-tuples
|
||||
! ] with-db ;
|
||||
person "PERSON"
|
||||
{
|
||||
{ "the-id" "ROWID" INTEGER +native-id+ }
|
||||
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ }
|
||||
{ "the-number" "AGE" INTEGER { +default+ 0 } }
|
||||
{ "real" "REAL" DOUBLE { +default+ 0.3 } }
|
||||
} define-persistent
|
||||
|
||||
"billy" 10 3.14 <person> the-person set
|
||||
|
||||
test-sqlite
|
||||
! test-postgresql
|
||||
|
||||
person "PERSON"
|
||||
{
|
||||
{ "the-id" "ROWID" INTEGER +assigned-id+ }
|
||||
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ }
|
||||
{ "the-number" "AGE" INTEGER { +default+ 0 } }
|
||||
{ "real" "REAL" DOUBLE { +default+ 0.3 } }
|
||||
} define-persistent
|
||||
|
||||
1 "billy" 20 6.28 <assigned-person> the-person set
|
||||
|
||||
test-sqlite
|
||||
! test-postgresql
|
||||
|
|
|
|||
|
|
@ -1,37 +1,28 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs classes db kernel namespaces
|
||||
tuples words sequences slots slots.private math
|
||||
math.parser io prettyprint db.types ;
|
||||
USE: continuations
|
||||
math.parser io prettyprint db.types continuations ;
|
||||
IN: db.tuples
|
||||
|
||||
! only take a tuple if you have to extract things from it
|
||||
! otherwise take a class
|
||||
! primary-key vs primary-key-spec
|
||||
! define-persistent should enforce a primary key
|
||||
! in sqlite, defining a new primary key makes it an alias for rowid, _rowid_, and oid
|
||||
! -sql outputs sql code
|
||||
! table - string
|
||||
! columns - seq of column specifiers
|
||||
|
||||
: db-columns ( class -- obj )
|
||||
"db-columns" word-prop ;
|
||||
|
||||
: db-table ( class -- obj )
|
||||
"db-table" word-prop ;
|
||||
: db-columns ( class -- obj ) "db-columns" word-prop ;
|
||||
: db-table ( class -- obj ) "db-table" word-prop ;
|
||||
|
||||
TUPLE: no-slot-named ;
|
||||
: no-slot-named ( -- * ) T{ no-slot-named } throw ;
|
||||
|
||||
: slot-spec-named ( str class -- slot-spec )
|
||||
"slots" word-prop [ slot-spec-name = ] with find nip ;
|
||||
"slots" word-prop [ slot-spec-name = ] with find nip
|
||||
[ no-slot-named ] unless* ;
|
||||
|
||||
: offset-of-slot ( str obj -- n )
|
||||
class slot-spec-named slot-spec-offset ;
|
||||
|
||||
: get-slot-named ( str obj -- value )
|
||||
tuck offset-of-slot slot ;
|
||||
tuck offset-of-slot [ no-slot-named ] unless* slot ;
|
||||
|
||||
: set-slot-named ( value str obj -- )
|
||||
tuck offset-of-slot set-slot ;
|
||||
|
||||
tuck offset-of-slot [ no-slot-named ] unless* set-slot ;
|
||||
|
||||
: primary-key-spec ( class -- spec )
|
||||
db-columns [ primary-key? ] find nip ;
|
||||
|
|
@ -43,7 +34,6 @@ IN: db.tuples
|
|||
[ class primary-key-spec first ] keep
|
||||
set-slot-named ;
|
||||
|
||||
|
||||
: cache-statement ( columns class assoc quot -- statement )
|
||||
[ db-table dupd ] swap
|
||||
[ <prepared-statement> ] 3compose cache nip ; inline
|
||||
|
|
@ -71,11 +61,15 @@ HOOK: tuple>params db ( columns tuple -- obj )
|
|||
|
||||
: tuple-statement ( columns tuple quot -- statement )
|
||||
>r [ tuple>params ] 2keep class r> call
|
||||
2dup . .
|
||||
[ bind-statement ] keep ;
|
||||
|
||||
: do-tuple-statement ( tuple columns-quot statement-quot -- )
|
||||
: make-tuple-statement ( tuple columns-quot statement-quot -- statement )
|
||||
>r [ class db-columns ] swap compose keep
|
||||
r> tuple-statement dup . execute-statement ;
|
||||
r> tuple-statement ;
|
||||
|
||||
: do-tuple-statement ( tuple columns-quot statement-quot -- )
|
||||
make-tuple-statement execute-statement ;
|
||||
|
||||
: create-table ( class -- )
|
||||
dup db-columns swap db-table create-sql sql-command ;
|
||||
|
|
@ -85,8 +79,8 @@ HOOK: tuple>params db ( columns tuple -- obj )
|
|||
|
||||
: insert-tuple ( tuple -- )
|
||||
[
|
||||
[ maybe-remove-id ] [ insert-sql ] do-tuple-statement
|
||||
last-id
|
||||
[ maybe-remove-id ] [ insert-sql ]
|
||||
make-tuple-statement execute-statement-last-id
|
||||
] keep set-primary-key ;
|
||||
|
||||
: update-tuple ( tuple -- )
|
||||
|
|
@ -101,19 +95,9 @@ HOOK: tuple>params db ( columns tuple -- obj )
|
|||
: persist ( tuple -- )
|
||||
dup primary-key [ update-tuple ] [ insert-tuple ] if ;
|
||||
|
||||
! PERSISTENT:
|
||||
|
||||
: define-persistent ( class table columns -- )
|
||||
>r dupd "db-table" set-word-prop r>
|
||||
"db-columns" set-word-prop ;
|
||||
|
||||
: define-relation ( spec -- )
|
||||
drop ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs db kernel math math.parser
|
||||
sequences continuations ;
|
||||
IN: db.types
|
||||
|
||||
|
||||
! id serial not null primary key,
|
||||
! ID is the Primary key
|
||||
SYMBOL: +native-id+
|
||||
SYMBOL: +assigned-id+
|
||||
|
|
@ -19,15 +19,8 @@ SYMBOL: +unique+
|
|||
SYMBOL: +default+
|
||||
SYMBOL: +null+
|
||||
SYMBOL: +not-null+
|
||||
SYMBOL: +has-many+
|
||||
|
||||
! SQLite Types
|
||||
! http://www.sqlite.org/datatype3.html
|
||||
! SYMBOL: NULL
|
||||
! SYMBOL: INTEGER
|
||||
! SYMBOL: REAL
|
||||
! SYMBOL: TEXT
|
||||
! SYMBOL: BLOB
|
||||
SYMBOL: +has-many+
|
||||
|
||||
SYMBOL: INTEGER
|
||||
SYMBOL: DOUBLE
|
||||
|
|
@ -41,24 +34,16 @@ SYMBOL: DATE
|
|||
|
||||
SYMBOL: BIG_INTEGER
|
||||
|
||||
! SYMBOL: LOCALE
|
||||
! SYMBOL: TIMEZONE
|
||||
! SYMBOL: CURRENCY
|
||||
|
||||
|
||||
! PostgreSQL Types
|
||||
! http://developer.postgresql.org/pgdocs/postgres/datatype.html
|
||||
|
||||
|
||||
: number>string* ( num/str -- str )
|
||||
dup number? [ number>string ] when ;
|
||||
|
||||
TUPLE: no-sql-type ;
|
||||
: no-sql-type ( -- * ) T{ no-sql-type } throw ;
|
||||
|
||||
HOOK: sql-modifiers* db ( modifiers -- str )
|
||||
HOOK: >sql-type db ( obj -- str )
|
||||
|
||||
! HOOK: >factor-type db ( obj -- obj )
|
||||
|
||||
|
||||
: number>string* ( n/str -- str )
|
||||
dup number? [ number>string ] when ;
|
||||
|
||||
: maybe-remove-id ( columns -- obj )
|
||||
[ +native-id+ swap member? not ] subset ;
|
||||
|
|
@ -68,3 +53,8 @@ HOOK: >sql-type db ( obj -- str )
|
|||
|
||||
: sql-modifiers ( spec -- seq )
|
||||
3 tail sql-modifiers* ;
|
||||
|
||||
! SQLite Types: http://www.sqlite.org/datatype3.html
|
||||
! NULL INTEGER REAL TEXT BLOB
|
||||
! PostgreSQL Types:
|
||||
! http://developer.postgresql.org/pgdocs/postgres/datatype.html
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
USING: definitions kernel parser words sequences math.parser
|
||||
namespaces editors io.launcher windows.shell32 io.files
|
||||
io.paths strings ;
|
||||
io.paths strings unicode.case ;
|
||||
IN: editors.editpadpro
|
||||
|
||||
: editpadpro-path
|
||||
\ editpadpro-path get-global [
|
||||
program-files "JGsoft" path+ walk-dir
|
||||
[ >lower "editpadpro.exe" tail? ] find nip
|
||||
program-files "JGsoft" path+
|
||||
[ >lower "editpadpro.exe" tail? ] find-file-breadth
|
||||
] unless* ;
|
||||
|
||||
: editpadpro ( file line -- )
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ IN: editors.editplus
|
|||
|
||||
: editplus-path ( -- path )
|
||||
\ editplus-path get-global [
|
||||
program-files "\\EditPlus 2\\editplus.exe" append
|
||||
program-files "\\EditPlus 2\\editplus.exe" path+
|
||||
] unless* ;
|
||||
|
||||
: editplus ( file line -- )
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
USING: editors.gvim.backend io.files io.windows kernel namespaces
|
||||
sequences windows.shell32 ;
|
||||
sequences windows.shell32 io.paths ;
|
||||
IN: editors.gvim.windows
|
||||
|
||||
M: windows-io gvim-path
|
||||
\ gvim-path get-global [
|
||||
program-files walk-dir [ "gvim.exe" tail? ] find nip
|
||||
program-files "vim" path+
|
||||
[ "gvim.exe" tail? ] find-file-breadth
|
||||
] unless* ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,11 @@
|
|||
USING: editors hardware-info.windows io.launcher kernel
|
||||
math.parser namespaces sequences windows.shell32 ;
|
||||
math.parser namespaces sequences windows.shell32 io.files
|
||||
arrays ;
|
||||
IN: editors.wordpad
|
||||
|
||||
: wordpad-path ( -- path )
|
||||
\ wordpad-path get [
|
||||
program-files "\\Windows NT\\Accessories\\wordpad.exe" append
|
||||
program-files "\\Windows NT\\Accessories\\wordpad.exe" path+
|
||||
] unless* ;
|
||||
|
||||
: wordpad ( file line -- )
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
|
||||
USING: kernel combinators sequences math math.functions math.vectors mortar slot-accessors
|
||||
x x.widgets.wm.root x.widgets.wm.frame combinators.lib ;
|
||||
|
||||
USING: kernel combinators sequences math math.functions math.vectors mortar
|
||||
slot-accessors x x.widgets.wm.root x.widgets.wm.frame sequences.lib ;
|
||||
IN: factory.commands
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
|
@ -72,4 +70,4 @@ drop
|
|||
|
||||
! { { [ dup empty? ] [ drop ] }
|
||||
! { [ dup length 1 = ] [ drop maximize ] }
|
||||
! { [ t ] [ tile-master* ] }
|
||||
! { [ t ] [ tile-master* ] }
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: help.syntax help.markup ;
|
||||
IN: hash2
|
||||
|
||||
ARTICLE: { "hash2" "intro" }
|
||||
ARTICLE: { "hash2" "intro" } "hash2 Vocabulary"
|
||||
"The hash2 vocabulary specifies a simple minimal datastructure for hash tables with two integers as keys. These hash tables are fixed size and do not conform to the associative mapping protocol. Words used in creating and manipulating these hash tables include:"
|
||||
{ $subsection <hash2> }
|
||||
{ $subsection hash2 }
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
USING: arrays combinators.lib io io.streams.string
|
||||
kernel math math.parser namespaces prettyprint
|
||||
sequences splitting strings ascii ;
|
||||
USING: arrays io io.streams.string kernel math math.parser namespaces
|
||||
prettyprint sequences sequences.lib splitting strings ascii ;
|
||||
IN: hexdump
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.backend kernel continuations namespaces sequences
|
||||
assocs hashtables sorting arrays ;
|
||||
assocs hashtables sorting arrays threads ;
|
||||
IN: io.monitors
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -17,7 +17,7 @@ TUPLE: monitor queue closed? ;
|
|||
set-monitor-queue
|
||||
} monitor construct ;
|
||||
|
||||
HOOK: fill-queue io-backend ( monitor -- )
|
||||
GENERIC: fill-queue ( monitor -- )
|
||||
|
||||
: changed-file ( changed path -- )
|
||||
namespace [ append ] change-at ;
|
||||
|
|
@ -25,6 +25,39 @@ HOOK: fill-queue io-backend ( monitor -- )
|
|||
: dequeue-change ( assoc -- path changes )
|
||||
delete-any prune natural-sort >array ;
|
||||
|
||||
M: monitor dispose
|
||||
dup check-monitor
|
||||
t over set-monitor-closed?
|
||||
delegate dispose ;
|
||||
|
||||
! Simple monitor; used on Linux and Mac OS X. On Windows,
|
||||
! monitors are full-fledged ports.
|
||||
TUPLE: simple-monitor handle callback ;
|
||||
|
||||
: <simple-monitor> ( handle -- simple-monitor )
|
||||
f (monitor) {
|
||||
set-simple-monitor-handle
|
||||
set-delegate
|
||||
} simple-monitor construct ;
|
||||
|
||||
: construct-simple-monitor ( handle class -- simple-monitor )
|
||||
>r <simple-monitor> r> construct-delegate ; inline
|
||||
|
||||
: notify-callback ( simple-monitor -- )
|
||||
dup simple-monitor-callback
|
||||
f rot set-simple-monitor-callback
|
||||
[ schedule-thread ] when* ;
|
||||
|
||||
M: simple-monitor fill-queue ( monitor -- )
|
||||
dup simple-monitor-callback [
|
||||
"Cannot wait for changes on the same file from multiple threads" throw
|
||||
] when
|
||||
[ swap set-simple-monitor-callback stop ] callcc0
|
||||
check-monitor ;
|
||||
|
||||
M: simple-monitor dispose ( monitor -- )
|
||||
dup delegate dispose notify-callback ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
HOOK: <monitor> io-backend ( path recursive? -- monitor )
|
||||
|
|
|
|||
|
|
@ -1,24 +1,49 @@
|
|||
USING: assocs io.files kernel namespaces sequences ;
|
||||
USING: arrays assocs combinators.lib dlists io.files
|
||||
kernel namespaces sequences shuffle vectors ;
|
||||
IN: io.paths
|
||||
|
||||
: find-file ( seq str -- path/f )
|
||||
[
|
||||
[ path+ exists? ] curry find nip
|
||||
] keep over [ path+ ] [ drop ] if ;
|
||||
! HOOK: library-roots io-backend ( -- seq )
|
||||
! HOOK: binary-roots io-backend ( -- seq )
|
||||
|
||||
<PRIVATE
|
||||
: append-path ( path files -- paths )
|
||||
[ path+ ] with map ;
|
||||
[ >r path+ r> ] with* assoc-map ;
|
||||
|
||||
: get-paths ( dir -- paths )
|
||||
dup directory keys append-path ;
|
||||
dup directory append-path ;
|
||||
|
||||
: (walk-dir) ( path -- )
|
||||
dup directory? [
|
||||
get-paths dup % [ (walk-dir) ] each
|
||||
first2 [
|
||||
get-paths dup keys % [ (walk-dir) ] each
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
PRIVATE>
|
||||
|
||||
: walk-dir ( path -- seq ) [ (walk-dir) ] { } make ;
|
||||
: walk-dir ( path -- seq )
|
||||
dup directory? 2array [ (walk-dir) ] { } make ;
|
||||
|
||||
GENERIC# find-file* 1 ( obj quot -- path/f )
|
||||
|
||||
M: dlist find-file* ( dlist quot -- path/f )
|
||||
over dlist-empty? [ 2drop f ] [
|
||||
2dup >r pop-front get-paths dup r> assoc-find
|
||||
[ drop 3nip ]
|
||||
[ 2drop [ nip ] assoc-subset keys pick push-all-back find-file* ] if
|
||||
] if ;
|
||||
|
||||
M: vector find-file* ( vector quot -- path/f )
|
||||
over empty? [ 2drop f ] [
|
||||
2dup >r pop get-paths dup r> assoc-find
|
||||
[ drop 3nip ]
|
||||
[ 2drop [ nip ] assoc-subset keys pick push-all find-file* ] if
|
||||
] if ;
|
||||
|
||||
: prepare-find-file ( quot -- quot )
|
||||
[ drop ] swap compose ;
|
||||
|
||||
: find-file-depth ( path quot -- path/f )
|
||||
prepare-find-file >r 1vector r> find-file* ;
|
||||
|
||||
: find-file-breadth ( path quot -- path/f )
|
||||
prepare-find-file >r 1dlist r> find-file* ;
|
||||
|
|
|
|||
|
|
@ -5,14 +5,14 @@ USING: io.backend io.unix.backend io.unix.kqueue io.unix.select
|
|||
io.launcher io.unix.launcher namespaces kernel assocs threads
|
||||
continuations ;
|
||||
|
||||
! On *BSD and Mac OS X, we use select() for the top-level
|
||||
! multiplexer, and we hang a kqueue off of it but file change
|
||||
! notification and process exit notification.
|
||||
! On Mac OS X, we use select() for the top-level
|
||||
! multiplexer, and we hang a kqueue off of it for process exit
|
||||
! notification.
|
||||
|
||||
! kqueue is buggy with files and ptys so we can't use it as the
|
||||
! main multiplexer.
|
||||
|
||||
TUPLE: bsd-io ;
|
||||
MIXIN: bsd-io
|
||||
|
||||
INSTANCE: bsd-io unix-io
|
||||
|
||||
|
|
@ -25,5 +25,3 @@ M: bsd-io init-io ( -- )
|
|||
|
||||
M: bsd-io register-process ( process -- )
|
||||
process-handle kqueue-mx get-global add-pid-task ;
|
||||
|
||||
T{ bsd-io } set-io-backend
|
||||
|
|
|
|||
|
|
@ -0,0 +1,8 @@
|
|||
IN: io.unix.freebsd
|
||||
USING: io.unix.bsd io.backend core-foundation.fsevents ;
|
||||
|
||||
TUPLE: freebsd-io ;
|
||||
|
||||
INSTANCE: freebsd-io bsd-io
|
||||
|
||||
T{ freebsd-io } set-io-backend
|
||||
|
|
@ -11,14 +11,10 @@ TUPLE: linux-io ;
|
|||
|
||||
INSTANCE: linux-io unix-io
|
||||
|
||||
TUPLE: linux-monitor path wd callback ;
|
||||
TUPLE: linux-monitor ;
|
||||
|
||||
: <linux-monitor> ( path wd -- monitor )
|
||||
f (monitor) {
|
||||
set-linux-monitor-path
|
||||
set-linux-monitor-wd
|
||||
set-delegate
|
||||
} linux-monitor construct ;
|
||||
: <linux-monitor> ( wd -- monitor )
|
||||
linux-monitor construct-simple-monitor ;
|
||||
|
||||
TUPLE: inotify watches ;
|
||||
|
||||
|
|
@ -42,34 +38,18 @@ TUPLE: inotify watches ;
|
|||
] when ;
|
||||
|
||||
: add-watch ( path mask -- monitor )
|
||||
dupd (add-watch)
|
||||
dup check-existing
|
||||
(add-watch) dup check-existing
|
||||
[ <linux-monitor> dup ] keep watches set-at ;
|
||||
|
||||
: remove-watch ( monitor -- )
|
||||
dup linux-monitor-wd watches delete-at
|
||||
linux-monitor-wd inotify-fd swap inotify_rm_watch io-error ;
|
||||
dup simple-monitor-handle watches delete-at
|
||||
simple-monitor-handle inotify-fd swap inotify_rm_watch io-error ;
|
||||
|
||||
M: linux-io <monitor> ( path recursive? -- monitor )
|
||||
drop IN_CHANGE_EVENTS add-watch ;
|
||||
|
||||
: notify-callback ( monitor -- )
|
||||
dup linux-monitor-callback
|
||||
f rot set-linux-monitor-callback
|
||||
[ schedule-thread ] when* ;
|
||||
|
||||
M: linux-io fill-queue ( monitor -- )
|
||||
dup linux-monitor-callback [
|
||||
"Cannot wait for changes on the same file from multiple threads" throw
|
||||
] when
|
||||
[ swap set-linux-monitor-callback stop ] callcc0
|
||||
check-monitor ;
|
||||
|
||||
M: linux-monitor dispose ( monitor -- )
|
||||
dup check-monitor
|
||||
t over set-monitor-closed?
|
||||
dup notify-callback
|
||||
remove-watch ;
|
||||
dup delegate dispose remove-watch ;
|
||||
|
||||
: ?flag ( n mask symbol -- n )
|
||||
pick rot bitand 0 > [ , ] [ drop ] if ;
|
||||
|
|
@ -136,5 +116,3 @@ M: linux-io init-io ( -- )
|
|||
T{ linux-io } set-io-backend
|
||||
|
||||
[ start-wait-thread ] "io.unix.linux" add-init-hook
|
||||
|
||||
"vocabs.monitor" require
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
IN: io.unix.macosx
|
||||
USING: io.unix.bsd io.backend io.monitors io.monitors.private
|
||||
continuations kernel core-foundation.fsevents sequences
|
||||
namespaces arrays ;
|
||||
|
||||
TUPLE: macosx-io ;
|
||||
|
||||
INSTANCE: macosx-io bsd-io
|
||||
|
||||
T{ macosx-io } set-io-backend
|
||||
|
||||
TUPLE: macosx-monitor ;
|
||||
|
||||
: enqueue-notifications ( triples monitor -- )
|
||||
tuck monitor-queue
|
||||
[ [ first { +modify-file+ } swap changed-file ] each ] bind
|
||||
notify-callback ;
|
||||
|
||||
M: macosx-io <monitor>
|
||||
drop
|
||||
f macosx-monitor construct-simple-monitor
|
||||
dup [ enqueue-notifications ] curry
|
||||
rot 1array 0 0 <event-stream>
|
||||
over set-simple-monitor-handle ;
|
||||
|
||||
M: macosx-monitor dispose
|
||||
dup simple-monitor-handle dispose delegate dispose ;
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
IN: io.unix.netbsd
|
||||
USING: io.unix.bsd io.backend ;
|
||||
|
||||
TUPLE: netbsd-io ;
|
||||
|
||||
INSTANCE: netbsd-io bsd-io
|
||||
|
||||
T{ netbsd-io } set-io-backend
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
IN: io.unix.openbsd
|
||||
USING: io.unix.bsd io.backend core-foundation.fsevents ;
|
||||
|
||||
TUPLE: openbsd-io ;
|
||||
|
||||
INSTANCE: openbsd-io bsd-io
|
||||
|
||||
T{ openbsd-io } set-io-backend
|
||||
|
|
@ -1,10 +1,7 @@
|
|||
USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
|
||||
io.unix.launcher io.unix.mmap io.backend combinators namespaces
|
||||
system vocabs.loader ;
|
||||
system vocabs.loader sequences ;
|
||||
|
||||
{
|
||||
{ [ bsd? ] [ "io.unix.bsd" ] }
|
||||
{ [ macosx? ] [ "io.unix.bsd" ] }
|
||||
{ [ linux? ] [ "io.unix.linux" ] }
|
||||
{ [ solaris? ] [ "io.unix.solaris" ] }
|
||||
} cond require
|
||||
"io.unix." os append require
|
||||
|
||||
"vocabs.monitor" require
|
||||
|
|
|
|||
|
|
@ -78,7 +78,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
|
||||
[ 2drop ] [ swap <displaced-alien> (changed-files) ] if ;
|
||||
|
||||
M: windows-nt-io fill-queue ( monitor -- )
|
||||
M: win32-monitor fill-queue ( monitor -- )
|
||||
dup buffer-ptr over read-changes
|
||||
[ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc
|
||||
swap set-monitor-queue ;
|
||||
|
|
|
|||
|
|
@ -12,5 +12,3 @@ USE: io.windows.mmap
|
|||
USE: io.backend
|
||||
|
||||
T{ windows-nt-io } set-io-backend
|
||||
|
||||
"vocabs.monitor" require
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: locals math sequences tools.test hashtables words kernel
|
||||
namespaces ;
|
||||
namespaces arrays ;
|
||||
IN: temporary
|
||||
|
||||
:: foo | a b | a a ;
|
||||
|
|
@ -35,6 +35,21 @@ IN: temporary
|
|||
:: let-test-3 | |
|
||||
[let | a [ ] | [let | b [ [ a ] ] | [let | a [ 3 ] | b ] ] ] ;
|
||||
|
||||
:: let-test-4 | |
|
||||
[let | a [ 1 ] b [ ] | a b 2array ] ;
|
||||
|
||||
[ { 1 2 } ] [ 2 let-test-4 ] unit-test
|
||||
|
||||
:: let-test-5 | |
|
||||
[let | a [ ] b [ ] | a b 2array ] ;
|
||||
|
||||
[ { 2 1 } ] [ 1 2 let-test-5 ] unit-test
|
||||
|
||||
:: let-test-6 | |
|
||||
[let | a [ ] b [ 1 ] | a b 2array ] ;
|
||||
|
||||
[ { 2 1 } ] [ 2 let-test-6 ] unit-test
|
||||
|
||||
[ -1 ] [ -1 let-test-3 call ] unit-test
|
||||
|
||||
[ 5 ] [
|
||||
|
|
@ -104,7 +119,6 @@ write-test-2 "q" set
|
|||
SYMBOL: a
|
||||
|
||||
:: use-test | a b c |
|
||||
USE: kernel
|
||||
;
|
||||
USE: kernel ;
|
||||
|
||||
[ t ] [ a symbol? ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces sequences sequences.private assocs
|
||||
math inference.transforms parser words quotations debugger
|
||||
macros arrays macros splitting combinators prettyprint.backend
|
||||
definitions prettyprint hashtables combinators.lib
|
||||
prettyprint.sections ;
|
||||
USING: kernel namespaces sequences sequences.private assocs math
|
||||
inference.transforms parser words quotations debugger macros
|
||||
arrays macros splitting combinators prettyprint.backend
|
||||
definitions prettyprint hashtables combinators.lib
|
||||
prettyprint.sections sequences.private ;
|
||||
IN: locals
|
||||
|
||||
! Inspired by
|
||||
|
|
@ -69,14 +69,14 @@ C: <quote> quote
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: localize-writer ( obj args -- quot )
|
||||
>r "local-reader" word-prop r> read-local [ set-first ] append ;
|
||||
>r "local-reader" word-prop r> read-local [ 0 swap set-array-nth ] append ;
|
||||
|
||||
: localize ( obj args -- quot )
|
||||
{
|
||||
{ [ over local? ] [ read-local ] }
|
||||
{ [ over quote? ] [ >r quote-local r> read-local ] }
|
||||
{ [ over local-word? ] [ read-local [ call ] append ] }
|
||||
{ [ over local-reader? ] [ read-local [ first ] append ] }
|
||||
{ [ over local-reader? ] [ read-local [ 0 swap array-nth ] append ] }
|
||||
{ [ over local-writer? ] [ localize-writer ] }
|
||||
{ [ over \ lambda eq? ] [ 2drop [ ] ] }
|
||||
{ [ t ] [ drop 1quotation ] }
|
||||
|
|
@ -138,34 +138,39 @@ M: quotation free-vars { } [ add-if-free ] reduce ;
|
|||
M: lambda free-vars
|
||||
dup lambda-vars swap lambda-body free-vars seq-diff ;
|
||||
|
||||
M: let free-vars
|
||||
dup let-vars swap let-body free-vars seq-diff ;
|
||||
|
||||
M: wlet free-vars
|
||||
dup wlet-vars swap wlet-body free-vars seq-diff ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! lambda-rewrite
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
GENERIC: lambda-rewrite* ( obj -- )
|
||||
|
||||
: lambda-rewrite [ lambda-rewrite* ] [ ] make ;
|
||||
GENERIC: local-rewrite* ( obj -- )
|
||||
|
||||
UNION: block quotation lambda ;
|
||||
: lambda-rewrite
|
||||
[ local-rewrite* ] [ ] make
|
||||
[ [ lambda-rewrite* ] each ] [ ] make ;
|
||||
|
||||
UNION: block callable lambda ;
|
||||
|
||||
GENERIC: block-vars ( block -- seq )
|
||||
|
||||
GENERIC: block-body ( block -- quot )
|
||||
|
||||
M: quotation block-vars drop { } ;
|
||||
M: callable block-vars drop { } ;
|
||||
|
||||
M: quotation block-body ;
|
||||
M: callable block-body ;
|
||||
|
||||
M: callable local-rewrite*
|
||||
[ [ local-rewrite* ] each ] [ ] make , ;
|
||||
|
||||
M: lambda block-vars lambda-vars ;
|
||||
|
||||
M: lambda block-body lambda-body ;
|
||||
|
||||
M: lambda local-rewrite*
|
||||
dup lambda-vars swap lambda-body
|
||||
[ local-rewrite* \ call , ] [ ] make <lambda> , ;
|
||||
|
||||
M: block lambda-rewrite*
|
||||
#! Turn free variables into bound variables, curry them
|
||||
#! onto the body
|
||||
|
|
@ -177,6 +182,8 @@ M: block lambda-rewrite*
|
|||
|
||||
M: object lambda-rewrite* , ;
|
||||
|
||||
M: object local-rewrite* , ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: make-locals ( seq -- words assoc )
|
||||
|
|
@ -227,16 +234,17 @@ M: object lambda-rewrite* , ;
|
|||
: parse-bindings ( -- alist )
|
||||
scan "|" assert= [ (parse-bindings) ] { } make dup keys ;
|
||||
|
||||
: let-rewrite ( words body -- )
|
||||
<lambda> lambda-rewrite* \ call , ;
|
||||
M: let local-rewrite*
|
||||
{ let-bindings let-vars let-body } get-slots -rot
|
||||
[ <reversed> ] 2apply
|
||||
[
|
||||
1array -rot second -rot <lambda>
|
||||
[ call ] curry compose
|
||||
] 2each local-rewrite* \ call , ;
|
||||
|
||||
M: let lambda-rewrite*
|
||||
dup let-bindings values [ lambda-rewrite* \ call , ] each
|
||||
{ let-vars let-body } get-slots let-rewrite ;
|
||||
|
||||
M: wlet lambda-rewrite*
|
||||
dup wlet-bindings values [ lambda-rewrite* ] each
|
||||
{ wlet-vars wlet-body } get-slots let-rewrite ;
|
||||
M: wlet local-rewrite*
|
||||
dup wlet-bindings values over wlet-vars rot wlet-body
|
||||
<lambda> [ call ] curry compose local-rewrite* \ call , ;
|
||||
|
||||
: (::) ( prop -- word quot n )
|
||||
>r CREATE dup reset-generic
|
||||
|
|
|
|||
|
|
@ -108,3 +108,12 @@ PRIVATE>
|
|||
swap -1.0 * exp
|
||||
*
|
||||
] if ;
|
||||
|
||||
! James Stirling's approximation for N!:
|
||||
! http://www.csse.monash.edu.au/~lloyd/tildeAlgDS/Numerical/Stirling/
|
||||
|
||||
: stirling-fact ( n -- fact )
|
||||
[ pi 2 * * sqrt ]
|
||||
[ dup e / swap ^ ]
|
||||
[ 12 * recip 1 + ]
|
||||
tri * * ;
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,5 +1,5 @@
|
|||
USING: combinators.lib kernel math math.analysis
|
||||
math.functions math.vectors sequences sequences.lib sorting ;
|
||||
USING: kernel math math.analysis math.functions math.vectors sequences
|
||||
sequences.lib sorting ;
|
||||
IN: math.statistics
|
||||
|
||||
: mean ( seq -- n )
|
||||
|
|
@ -43,9 +43,9 @@ IN: math.statistics
|
|||
: ste ( seq -- x )
|
||||
#! standard error, standard deviation / sqrt ( length of sequence )
|
||||
dup std swap length sqrt / ;
|
||||
|
||||
|
||||
: ((r)) ( mean(x) mean(y) {x} {y} -- (r) )
|
||||
! finds sigma((xi-mean(x))(yi-mean(y))
|
||||
! finds sigma((xi-mean(x))(yi-mean(y))
|
||||
0 [ [ >r pick r> swap - ] 2apply * + ] 2reduce 2nip ;
|
||||
|
||||
: (r) ( mean(x) mean(y) {x} {y} sx sy -- r )
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ IN: multiline
|
|||
|
||||
: STRING:
|
||||
CREATE dup reset-generic
|
||||
parse-here 1quotation define ; parsing
|
||||
parse-here 1quotation define-inline ; parsing
|
||||
|
||||
: (parse-multiline-string) ( start-index end-text -- end-index )
|
||||
lexer get lexer-line-text [
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! TODO:
|
||||
! TODO:
|
||||
! based on number of channels in file.
|
||||
! - End of decoding is indicated by an exception when reading the stream.
|
||||
! How to work around this? C player example uses feof but streams don't
|
||||
|
|
@ -14,27 +14,27 @@ USING: kernel alien ogg ogg.vorbis ogg.theora io byte-arrays
|
|||
sequences libc shuffle alien.c-types system openal math
|
||||
namespaces threads shuffle opengl arrays ui.gadgets.worlds
|
||||
combinators math.parser ui.gadgets ui.render opengl.gl ui
|
||||
continuations io.files hints combinators.lib ;
|
||||
continuations io.files hints combinators.lib sequences.lib ;
|
||||
|
||||
IN: ogg.player
|
||||
|
||||
: audio-buffer-size ( -- number ) 128 1024 * ; inline
|
||||
: audio-buffer-size ( -- number ) 128 1024 * ; inline
|
||||
|
||||
TUPLE: player stream temp-state
|
||||
op oy og
|
||||
TUPLE: player stream temp-state
|
||||
op oy og
|
||||
vo vi vd vb vc vorbis
|
||||
to ti tc td yuv rgb theora video-ready? video-time video-granulepos
|
||||
source buffers buffer-indexes start-time
|
||||
playing? audio-full? audio-index audio-buffer audio-granulepos
|
||||
playing? audio-full? audio-index audio-buffer audio-granulepos
|
||||
gadget ;
|
||||
|
||||
: init-vorbis ( player -- )
|
||||
dup player-oy ogg_sync_init drop
|
||||
dup player-vi vorbis_info_init
|
||||
dup player-vi vorbis_info_init
|
||||
player-vc vorbis_comment_init ;
|
||||
|
||||
: init-theora ( player -- )
|
||||
dup player-ti theora_info_init
|
||||
dup player-ti theora_info_init
|
||||
player-tc theora_comment_init ;
|
||||
|
||||
: init-sound ( player -- )
|
||||
|
|
@ -45,45 +45,45 @@ TUPLE: player stream temp-state
|
|||
|
||||
: <player> ( stream -- player )
|
||||
{ set-player-stream } player construct
|
||||
0 over set-player-vorbis
|
||||
0 over set-player-theora
|
||||
0 over set-player-video-time
|
||||
0 over set-player-video-granulepos
|
||||
0 over set-player-vorbis
|
||||
0 over set-player-theora
|
||||
0 over set-player-video-time
|
||||
0 over set-player-video-granulepos
|
||||
f over set-player-video-ready?
|
||||
f over set-player-audio-full?
|
||||
0 over set-player-audio-index
|
||||
0 over set-player-start-time
|
||||
0 over set-player-audio-index
|
||||
0 over set-player-start-time
|
||||
audio-buffer-size "short" <c-array> over set-player-audio-buffer
|
||||
0 over set-player-audio-granulepos
|
||||
f over set-player-playing?
|
||||
"ogg_packet" malloc-object over set-player-op
|
||||
"ogg_sync_state" malloc-object over set-player-oy
|
||||
"ogg_sync_state" malloc-object over set-player-oy
|
||||
"ogg_page" malloc-object over set-player-og
|
||||
"ogg_stream_state" malloc-object over set-player-vo
|
||||
"vorbis_info" malloc-object over set-player-vi
|
||||
"vorbis_dsp_state" malloc-object over set-player-vd
|
||||
"vorbis_block" malloc-object over set-player-vb
|
||||
"vorbis_comment" malloc-object over set-player-vc
|
||||
"vorbis_comment" malloc-object over set-player-vc
|
||||
"ogg_stream_state" malloc-object over set-player-to
|
||||
"theora_info" malloc-object over set-player-ti
|
||||
"theora_comment" malloc-object over set-player-tc
|
||||
"theora_state" malloc-object over set-player-td
|
||||
"theora_state" malloc-object over set-player-td
|
||||
"yuv_buffer" <c-object> over set-player-yuv
|
||||
"ogg_stream_state" <c-object> over set-player-temp-state
|
||||
dup init-sound
|
||||
dup init-vorbis
|
||||
dup init-vorbis
|
||||
dup init-theora ;
|
||||
|
||||
: num-channels ( player -- channels )
|
||||
player-vi vorbis_info-channels ;
|
||||
|
||||
|
||||
: al-channel-format ( player -- format )
|
||||
num-channels 1 = [ AL_FORMAT_MONO16 ] [ AL_FORMAT_STEREO16 ] if ;
|
||||
|
||||
: get-time ( player -- time )
|
||||
dup player-start-time zero? [
|
||||
millis over set-player-start-time
|
||||
] when
|
||||
] when
|
||||
player-start-time millis swap - 1000.0 /f ;
|
||||
|
||||
: clamp ( n -- n )
|
||||
|
|
@ -149,28 +149,28 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
dup player-gadget [
|
||||
dup { player-td player-yuv } get-slots theora_decode_YUVout drop
|
||||
dup player-rgb over player-yuv yuv>rgb
|
||||
dup player-gadget find-world dup draw-world
|
||||
dup player-gadget find-world dup draw-world
|
||||
] when ;
|
||||
|
||||
: num-audio-buffers-processed ( player -- player n )
|
||||
dup player-source AL_BUFFERS_PROCESSED 0 <uint>
|
||||
dup player-source AL_BUFFERS_PROCESSED 0 <uint>
|
||||
[ alGetSourcei check-error ] keep *uint ;
|
||||
|
||||
|
||||
: append-new-audio-buffer ( player -- player )
|
||||
dup player-buffers 1 gen-buffers append over set-player-buffers
|
||||
dup player-buffers 1 gen-buffers append over set-player-buffers
|
||||
[ [ player-buffers second ] keep al-channel-format ] keep
|
||||
[ player-audio-buffer dup length ] keep
|
||||
[ player-vi vorbis_info-rate alBufferData check-error ] keep
|
||||
[ player-vi vorbis_info-rate alBufferData check-error ] keep
|
||||
[ player-source 1 ] keep
|
||||
[ player-buffers second <uint> alSourceQueueBuffers check-error ] keep ;
|
||||
|
||||
: fill-processed-audio-buffer ( player n -- player )
|
||||
#! n is the number of audio buffers processed
|
||||
#! n is the number of audio buffers processed
|
||||
over >r >r dup player-source r> pick player-buffer-indexes
|
||||
[ alSourceUnqueueBuffers check-error ] keep
|
||||
*uint dup r> swap >r al-channel-format rot
|
||||
[ alSourceUnqueueBuffers check-error ] keep
|
||||
*uint dup r> swap >r al-channel-format rot
|
||||
[ player-audio-buffer dup length ] keep
|
||||
[ player-vi vorbis_info-rate alBufferData check-error ] keep
|
||||
[ player-vi vorbis_info-rate alBufferData check-error ] keep
|
||||
[ player-source 1 ] keep
|
||||
r> <uint> swap >r alSourceQueueBuffers check-error r> ;
|
||||
|
||||
|
|
@ -179,12 +179,12 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
{ [ over player-buffers length 1 = over zero? and ] [ drop append-new-audio-buffer t ] }
|
||||
{ [ over player-buffers length 2 = over zero? and ] [ 0 sleep drop f ] }
|
||||
{ [ t ] [ fill-processed-audio-buffer t ] }
|
||||
} cond ;
|
||||
} cond ;
|
||||
|
||||
: start-audio ( player -- player bool )
|
||||
[ [ player-buffers first ] keep al-channel-format ] keep
|
||||
[ player-audio-buffer dup length ] keep
|
||||
[ player-vi vorbis_info-rate alBufferData check-error ] keep
|
||||
[ player-vi vorbis_info-rate alBufferData check-error ] keep
|
||||
[ player-source 1 ] keep
|
||||
[ player-buffers first <uint> alSourceQueueBuffers check-error ] keep
|
||||
[ player-source alSourcePlay check-error ] keep
|
||||
|
|
@ -201,12 +201,12 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
: check-not-negative ( int -- )
|
||||
0 < [ "Word result was a negative number." throw ] when ;
|
||||
|
||||
: buffer-size ( -- number )
|
||||
: buffer-size ( -- number )
|
||||
4096 ; inline
|
||||
|
||||
: sync-buffer ( player -- buffer size player )
|
||||
[ player-oy buffer-size ogg_sync_buffer buffer-size ] keep ;
|
||||
|
||||
|
||||
: stream-into-buffer ( buffer size player -- len player )
|
||||
[ player-stream read-bytes-into ] keep ;
|
||||
|
||||
|
|
@ -217,23 +217,23 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
#! Take some compressed bitstream data and sync it for
|
||||
#! page extraction.
|
||||
sync-buffer stream-into-buffer confirm-buffer ;
|
||||
|
||||
|
||||
: queue-page ( player -- player )
|
||||
#! Push a page into the stream for packetization
|
||||
[ { player-vo player-og } get-slots ogg_stream_pagein drop ] keep
|
||||
[ { player-vo player-og } get-slots ogg_stream_pagein drop ] keep
|
||||
[ { player-to player-og } get-slots ogg_stream_pagein drop ] keep ;
|
||||
|
||||
: retrieve-page ( player -- player bool )
|
||||
#! Sync the streams and get a page. Return true if a page was
|
||||
#! successfully retrieved.
|
||||
dup { player-oy player-og } get-slots ogg_sync_pageout 0 > ;
|
||||
dup { player-oy player-og } get-slots ogg_sync_pageout 0 > ;
|
||||
|
||||
: standard-initial-header? ( player -- player bool )
|
||||
dup player-og ogg_page_bos zero? not ;
|
||||
|
||||
: ogg-stream-init ( player -- state player )
|
||||
#! Init the encode/decode logical stream state
|
||||
[ player-temp-state ] keep
|
||||
[ player-temp-state ] keep
|
||||
[ player-og ogg_page_serialno ogg_stream_init check-not-negative ] 2keep ;
|
||||
|
||||
: ogg-stream-pagein ( state player -- state player )
|
||||
|
|
@ -266,11 +266,11 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
|
||||
: is-vorbis-packet? ( player -- player bool )
|
||||
dup player-vorbis zero? [ vorbis-header? ] [ f ] if ;
|
||||
|
||||
|
||||
: copy-to-vorbis-state ( state player -- player )
|
||||
#! Copy the state to the vorbis state structure in the player
|
||||
[ player-vo swap dup length memcpy ] keep ;
|
||||
|
||||
|
||||
: handle-initial-vorbis-header ( state player -- player )
|
||||
copy-to-vorbis-state 1 over set-player-vorbis ;
|
||||
|
||||
|
|
@ -293,16 +293,16 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
#! Parse Vorbis headers, ignoring any other type stored
|
||||
#! in the Ogg container.
|
||||
retrieve-page [
|
||||
process-initial-header [
|
||||
process-initial-header [
|
||||
parse-initial-headers
|
||||
] [
|
||||
#! Don't leak the page, get it into the appropriate stream
|
||||
queue-page
|
||||
] if
|
||||
] [
|
||||
queue-page
|
||||
] if
|
||||
] [
|
||||
buffer-data not [ parse-initial-headers ] when
|
||||
] if ;
|
||||
|
||||
|
||||
: have-required-vorbis-headers? ( player -- player bool )
|
||||
#! Return true if we need to decode vorbis due to there being
|
||||
#! vorbis headers read from the stream but we don't have them all
|
||||
|
|
@ -350,17 +350,17 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
get-remaining-vorbis-header-packet [
|
||||
decode-remaining-vorbis-header-packet
|
||||
increment-vorbis-header-count
|
||||
parse-remaining-vorbis-headers
|
||||
] when
|
||||
parse-remaining-vorbis-headers
|
||||
] when
|
||||
] when ;
|
||||
|
||||
: parse-remaining-theora-headers ( player -- player )
|
||||
have-required-theora-headers? not [
|
||||
get-remaining-theora-header-packet [
|
||||
decode-remaining-theora-header-packet
|
||||
decode-remaining-theora-header-packet
|
||||
increment-theora-header-count
|
||||
parse-remaining-theora-headers
|
||||
] when
|
||||
parse-remaining-theora-headers
|
||||
] when
|
||||
] when ;
|
||||
|
||||
: get-more-header-data ( player -- player )
|
||||
|
|
@ -368,12 +368,12 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
|
||||
: parse-remaining-headers ( player -- player )
|
||||
have-required-vorbis-headers? not swap have-required-theora-headers? not swapd or [
|
||||
parse-remaining-vorbis-headers
|
||||
parse-remaining-vorbis-headers
|
||||
parse-remaining-theora-headers
|
||||
retrieve-page [ queue-page ] [ get-more-header-data ] if
|
||||
parse-remaining-headers
|
||||
] when ;
|
||||
|
||||
|
||||
: tear-down-vorbis ( player -- player )
|
||||
dup player-vi vorbis_info_clear
|
||||
dup player-vc vorbis_comment_clear ;
|
||||
|
|
@ -387,8 +387,8 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
dup { player-vd player-vb } get-slots vorbis_block_init drop ;
|
||||
|
||||
: init-theora-codec ( player -- player )
|
||||
dup { player-td player-ti } get-slots theora_decode_init drop
|
||||
dup player-ti theora_info-frame_width over player-ti theora_info-frame_height
|
||||
dup { player-td player-ti } get-slots theora_decode_init drop
|
||||
dup player-ti theora_info-frame_width over player-ti theora_info-frame_height
|
||||
4 * * <byte-array> over set-player-rgb ;
|
||||
|
||||
|
||||
|
|
@ -412,36 +412,36 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
"x" %
|
||||
dup player-ti theora_info-height #
|
||||
" " %
|
||||
dup player-ti theora_info-fps_numerator
|
||||
dup player-ti theora_info-fps_numerator
|
||||
over player-ti theora_info-fps_denominator /f #
|
||||
" fps video" %
|
||||
] "" make print ;
|
||||
|
||||
: initialize-decoder ( player -- player )
|
||||
dup player-vorbis zero? [ tear-down-vorbis ] [ init-vorbis-codec display-vorbis-details ] if
|
||||
dup player-vorbis zero? [ tear-down-vorbis ] [ init-vorbis-codec display-vorbis-details ] if
|
||||
dup player-theora zero? [ tear-down-theora ] [ init-theora-codec display-theora-details ] if ;
|
||||
|
||||
|
||||
: sync-pages ( player -- player )
|
||||
retrieve-page [
|
||||
queue-page sync-pages
|
||||
queue-page sync-pages
|
||||
] when ;
|
||||
|
||||
: audio-buffer-not-ready? ( player -- player bool )
|
||||
dup player-vorbis zero? not over player-audio-full? not and ;
|
||||
|
||||
|
||||
: pending-decoded-audio? ( player -- player pcm len bool )
|
||||
f <void*> 2dup >r player-vd r> vorbis_synthesis_pcmout dup 0 > ;
|
||||
|
||||
: buffer-space-available ( player -- available )
|
||||
audio-buffer-size swap player-audio-index - ;
|
||||
|
||||
|
||||
: samples-to-read ( player available len -- numread )
|
||||
>r swap num-channels / r> min ;
|
||||
|
||||
: each-with3 ( obj obj obj seq quot -- ) 3 each-withn ; inline
|
||||
|
||||
: each-with3 ( obj obj obj seq quot -- ) 3 each-withn ; inline
|
||||
|
||||
: add-to-buffer ( player val -- )
|
||||
over player-audio-index pick player-audio-buffer set-short-nth
|
||||
over player-audio-index pick player-audio-buffer set-short-nth
|
||||
dup player-audio-index 1+ swap set-player-audio-index ;
|
||||
|
||||
: get-audio-value ( pcm sample channel -- value )
|
||||
|
|
@ -452,15 +452,15 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
|
||||
: (process-sample) ( player pcm sample -- )
|
||||
pick num-channels [ process-channels ] each-with3 ;
|
||||
|
||||
|
||||
: process-samples ( player pcm numread -- )
|
||||
[ (process-sample) ] each-with2 ;
|
||||
|
||||
: decode-pending-audio ( player pcm result -- player )
|
||||
! [ "ret = " % dup # ] "" make write
|
||||
pick [ buffer-space-available swap ] keep -rot samples-to-read
|
||||
pick [ buffer-space-available swap ] keep -rot samples-to-read
|
||||
pick over >r >r process-samples r> r> swap
|
||||
! numread player
|
||||
! numread player
|
||||
dup player-audio-index audio-buffer-size = [
|
||||
t over set-player-audio-full?
|
||||
] when
|
||||
|
|
@ -480,10 +480,10 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
dup { player-vb player-op } get-slots vorbis_synthesis 0 = [
|
||||
dup { player-vd player-vb } get-slots vorbis_synthesis_blockin drop
|
||||
] when
|
||||
t
|
||||
t
|
||||
] [
|
||||
#! Need more data. Break out to suck in another page.
|
||||
f
|
||||
f
|
||||
] if ;
|
||||
|
||||
: decode-audio ( player -- player )
|
||||
|
|
@ -504,13 +504,13 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
dup { player-to player-op } get-slots ogg_stream_packetout 0 > [
|
||||
dup { player-td player-op } get-slots theora_decode_packetin drop
|
||||
dup player-td theora_state-granulepos over set-player-video-granulepos
|
||||
dup { player-td player-video-granulepos } get-slots theora_granule_time
|
||||
dup { player-td player-video-granulepos } get-slots theora_granule_time
|
||||
over set-player-video-time
|
||||
t over set-player-video-ready?
|
||||
decode-video
|
||||
decode-video
|
||||
] when
|
||||
] when ;
|
||||
|
||||
|
||||
: decode ( player -- player )
|
||||
get-more-header-data sync-pages
|
||||
decode-audio
|
||||
|
|
@ -520,7 +520,7 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
f over set-player-audio-full?
|
||||
0 over set-player-audio-index
|
||||
] when
|
||||
] when
|
||||
] when
|
||||
dup player-video-ready? [
|
||||
dup player-video-time over get-time - dup 0.0 < [
|
||||
-0.1 > [ process-video ] when
|
||||
|
|
@ -539,7 +539,7 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
[ player-vi free ] keep
|
||||
[ player-vd free ] keep
|
||||
[ player-vb free ] keep
|
||||
[ player-vc free ] keep
|
||||
[ player-vc free ] keep
|
||||
[ player-to free ] keep
|
||||
[ player-ti free ] keep
|
||||
[ player-tc free ] keep
|
||||
|
|
@ -550,23 +550,23 @@ HINTS: yuv>rgb byte-array byte-array ;
|
|||
[
|
||||
|
||||
num-audio-buffers-processed over player-source rot player-buffer-indexes swapd
|
||||
alSourceUnqueueBuffers check-error
|
||||
alSourceUnqueueBuffers check-error
|
||||
] keep ;
|
||||
|
||||
: delete-openal-buffers ( player -- player )
|
||||
[
|
||||
[
|
||||
player-buffers [
|
||||
1 swap <uint> alDeleteBuffers check-error
|
||||
] each
|
||||
] each
|
||||
] keep ;
|
||||
|
||||
: delete-openal-source ( player -- player )
|
||||
[ player-source 1 swap <uint> alDeleteSources check-error ] keep ;
|
||||
|
||||
: cleanup ( player -- player )
|
||||
free-malloced-objects
|
||||
free-malloced-objects
|
||||
unqueue-openal-buffers
|
||||
delete-openal-buffers
|
||||
delete-openal-buffers
|
||||
delete-openal-source ;
|
||||
|
||||
: wait-for-sound ( player -- player )
|
||||
|
|
@ -583,7 +583,7 @@ TUPLE: theora-gadget player ;
|
|||
theora-gadget construct-gadget
|
||||
[ set-theora-gadget-player ] keep ;
|
||||
|
||||
M: theora-gadget pref-dim*
|
||||
M: theora-gadget pref-dim*
|
||||
theora-gadget-player
|
||||
player-ti dup theora_info-width swap theora_info-height 2array ;
|
||||
|
||||
|
|
@ -598,10 +598,10 @@ M: theora-gadget draw-gadget* ( gadget -- )
|
|||
"Theora Player" open-window ;
|
||||
|
||||
: play-ogg ( player -- )
|
||||
parse-initial-headers
|
||||
parse-remaining-headers
|
||||
initialize-decoder
|
||||
dup player-gadget [ initialize-gui ] when*
|
||||
parse-initial-headers
|
||||
parse-remaining-headers
|
||||
initialize-decoder
|
||||
dup player-gadget [ initialize-gui ] when*
|
||||
[ decode ] [ drop ] recover
|
||||
! decode
|
||||
wait-for-sound
|
||||
|
|
@ -615,8 +615,8 @@ M: theora-gadget draw-gadget* ( gadget -- )
|
|||
<file-reader> play-vorbis-stream ;
|
||||
|
||||
: play-theora-stream ( stream -- )
|
||||
<player>
|
||||
dup <theora-gadget> over set-player-gadget
|
||||
<player>
|
||||
dup <theora-gadget> over set-player-gadget
|
||||
play-ogg ;
|
||||
|
||||
: play-theora-file ( filename -- )
|
||||
|
|
|
|||
|
|
@ -0,0 +1,46 @@
|
|||
USING: alien alien.syntax combinators kernel parser sequences
|
||||
system words namespaces hashtables init math arrays assocs
|
||||
sequences.lib continuations ;
|
||||
<< {
|
||||
{ [ windows? ] [ "opengl.gl.windows" ] }
|
||||
{ [ macosx? ] [ "opengl.gl.macosx" ] }
|
||||
{ [ unix? ] [ "opengl.gl.unix" ] }
|
||||
{ [ t ] [ "Unknown OpenGL platform" throw ] }
|
||||
} cond use+ >>
|
||||
IN: opengl.gl.extensions
|
||||
|
||||
SYMBOL: +gl-function-number-counter+
|
||||
SYMBOL: +gl-function-pointers+
|
||||
|
||||
: reset-gl-function-number-counter ( -- )
|
||||
0 +gl-function-number-counter+ set-global ;
|
||||
: reset-gl-function-pointers ( -- )
|
||||
100 <hashtable> +gl-function-pointers+ set-global ;
|
||||
|
||||
[ reset-gl-function-pointers ] "opengl.gl init hook" add-init-hook
|
||||
reset-gl-function-pointers
|
||||
reset-gl-function-number-counter
|
||||
|
||||
: gl-function-number ( -- n )
|
||||
+gl-function-number-counter+ get-global
|
||||
dup 1+ +gl-function-number-counter+ set-global ;
|
||||
|
||||
: gl-function-pointer ( names n -- funptr )
|
||||
gl-function-context 2array dup +gl-function-pointers+ get-global at
|
||||
[ 2nip ] [
|
||||
>r [ gl-function-address ] attempt-each
|
||||
dup [ "OpenGL function not available" throw ] unless
|
||||
dup r>
|
||||
+gl-function-pointers+ get-global set-at
|
||||
] if* ;
|
||||
|
||||
: GL-FUNCTION:
|
||||
gl-function-calling-convention
|
||||
scan
|
||||
scan dup
|
||||
scan drop "}" parse-tokens swap add*
|
||||
gl-function-number
|
||||
[ gl-function-pointer ] 2curry swap
|
||||
";" parse-tokens [ "()" subseq? not ] subset
|
||||
define-indirect
|
||||
; parsing
|
||||
|
|
@ -3,8 +3,8 @@
|
|||
|
||||
! This file is based on the gl.h that comes with xorg-x11 6.8.2
|
||||
|
||||
USING: alien alien.syntax kernel parser sequences system words ;
|
||||
<< windows? "opengl.gl.windows" "opengl.gl.unix" ? use+ >>
|
||||
USING: alien alien.syntax combinators kernel parser sequences
|
||||
system words opengl.gl.extensions ;
|
||||
|
||||
IN: opengl.gl
|
||||
|
||||
|
|
@ -1119,16 +1119,10 @@ FUNCTION: void glLoadName ( GLuint name ) ;
|
|||
FUNCTION: void glPushName ( GLuint name ) ;
|
||||
FUNCTION: void glPopName ( ) ;
|
||||
|
||||
|
||||
! OpenGL extension functions
|
||||
|
||||
|
||||
|
||||
|
||||
<< reset-gl-function-number-counter >>
|
||||
|
||||
! OpenGL 1.2
|
||||
|
||||
|
||||
: GL_SMOOTH_POINT_SIZE_RANGE HEX: 0B12 ; inline
|
||||
: GL_SMOOTH_POINT_SIZE_GRANULARITY HEX: 0B13 ; inline
|
||||
: GL_SMOOTH_LINE_WIDTH_RANGE HEX: 0B22 ; inline
|
||||
|
|
@ -1171,10 +1165,10 @@ FUNCTION: void glPopName ( ) ;
|
|||
: GL_ALIASED_POINT_SIZE_RANGE HEX: 846D ; inline
|
||||
: GL_ALIASED_LINE_WIDTH_RANGE HEX: 846E ; inline
|
||||
|
||||
GL-FUNCTION: void glCopyTexSubImage3D ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLint x, GLint y, GLsizei width, GLsizei height ) ;
|
||||
GL-FUNCTION: void glDrawRangeElements ( GLenum mode, GLuint start, GLuint end, GLsizei count, GLenum type, GLvoid* indices ) ;
|
||||
GL-FUNCTION: void glTexImage3D ( GLenum target, GLint level, GLint internalFormat, GLsizei width, GLsizei height, GLsizei depth, GLint border, GLenum format, GLenum type, GLvoid* pixels ) ;
|
||||
GL-FUNCTION: void glTexSubImage3D ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLvoid* pixels ) ;
|
||||
GL-FUNCTION: void glCopyTexSubImage3D { glCopyTexSubImage3DEXT } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLint x, GLint y, GLsizei width, GLsizei height ) ;
|
||||
GL-FUNCTION: void glDrawRangeElements { glDrawRangeElementsEXT } ( GLenum mode, GLuint start, GLuint end, GLsizei count, GLenum type, GLvoid* indices ) ;
|
||||
GL-FUNCTION: void glTexImage3D { glTexImage3DEXT } ( GLenum target, GLint level, GLint internalFormat, GLsizei width, GLsizei height, GLsizei depth, GLint border, GLenum format, GLenum type, GLvoid* pixels ) ;
|
||||
GL-FUNCTION: void glTexSubImage3D { glTexSubImage3DEXT } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLvoid* pixels ) ;
|
||||
|
||||
|
||||
! OpenGL 1.3
|
||||
|
|
@ -1277,52 +1271,52 @@ GL-FUNCTION: void glTexSubImage3D ( GLenum target, GLint level, GLint xoffset, G
|
|||
: GL_DOT3_RGBA HEX: 86AF ; inline
|
||||
: GL_MULTISAMPLE_BIT HEX: 20000000 ; inline
|
||||
|
||||
GL-FUNCTION: void glActiveTexture ( GLenum texture ) ;
|
||||
GL-FUNCTION: void glClientActiveTexture ( GLenum texture ) ;
|
||||
GL-FUNCTION: void glCompressedTexImage1D ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLint border, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexImage2D ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLsizei height, GLint border, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexImage3D ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLsizei height, GLsizei depth, GLint border, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexSubImage1D ( GLenum target, GLint level, GLint xoffset, GLsizei width, GLenum format, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexSubImage2D ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLsizei width, GLsizei height, GLenum format, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexSubImage3D ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glGetCompressedTexImage ( GLenum target, GLint lod, GLvoid* img ) ;
|
||||
GL-FUNCTION: void glLoadTransposeMatrixd ( GLdouble m[16] ) ;
|
||||
GL-FUNCTION: void glLoadTransposeMatrixf ( GLfloat m[16] ) ;
|
||||
GL-FUNCTION: void glMultTransposeMatrixd ( GLdouble m[16] ) ;
|
||||
GL-FUNCTION: void glMultTransposeMatrixf ( GLfloat m[16] ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1d ( GLenum target, GLdouble s ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1dv ( GLenum target, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1f ( GLenum target, GLfloat s ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1fv ( GLenum target, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1i ( GLenum target, GLint s ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1iv ( GLenum target, GLint* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1s ( GLenum target, GLshort s ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1sv ( GLenum target, GLshort* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2d ( GLenum target, GLdouble s, GLdouble t ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2dv ( GLenum target, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2f ( GLenum target, GLfloat s, GLfloat t ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2fv ( GLenum target, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2i ( GLenum target, GLint s, GLint t ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2iv ( GLenum target, GLint* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2s ( GLenum target, GLshort s, GLshort t ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2sv ( GLenum target, GLshort* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3d ( GLenum target, GLdouble s, GLdouble t, GLdouble r ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3dv ( GLenum target, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3f ( GLenum target, GLfloat s, GLfloat t, GLfloat r ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3fv ( GLenum target, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3i ( GLenum target, GLint s, GLint t, GLint r ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3iv ( GLenum target, GLint* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3s ( GLenum target, GLshort s, GLshort t, GLshort r ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3sv ( GLenum target, GLshort* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4d ( GLenum target, GLdouble s, GLdouble t, GLdouble r, GLdouble q ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4dv ( GLenum target, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4f ( GLenum target, GLfloat s, GLfloat t, GLfloat r, GLfloat q ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4fv ( GLenum target, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4i ( GLenum target, GLint s, GLint t, GLint r, GLint q ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4iv ( GLenum target, GLint* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4s ( GLenum target, GLshort s, GLshort t, GLshort r, GLshort q ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4sv ( GLenum target, GLshort* v ) ;
|
||||
GL-FUNCTION: void glSampleCoverage ( GLclampf value, GLboolean invert ) ;
|
||||
GL-FUNCTION: void glActiveTexture { glActiveTextureARB } ( GLenum texture ) ;
|
||||
GL-FUNCTION: void glClientActiveTexture { glClientActiveTextureARB } ( GLenum texture ) ;
|
||||
GL-FUNCTION: void glCompressedTexImage1D { glCompressedTexImage1DARB } ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLint border, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexImage2D { glCompressedTexImage2DARB } ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLsizei height, GLint border, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexImage3D { glCompressedTexImage2DARB } ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLsizei height, GLsizei depth, GLint border, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexSubImage1D { glCompressedTexSubImage1DARB } ( GLenum target, GLint level, GLint xoffset, GLsizei width, GLenum format, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexSubImage2D { glCompressedTexSubImage2DARB } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLsizei width, GLsizei height, GLenum format, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glCompressedTexSubImage3D { glCompressedTexSubImage3DARB } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLsizei imageSize, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glGetCompressedTexImage { glGetCompressedTexImageARB } ( GLenum target, GLint lod, GLvoid* img ) ;
|
||||
GL-FUNCTION: void glLoadTransposeMatrixd { glLoadTransposeMatrixdARB } ( GLdouble m[16] ) ;
|
||||
GL-FUNCTION: void glLoadTransposeMatrixf { glLoadTransposeMatrixfARB } ( GLfloat m[16] ) ;
|
||||
GL-FUNCTION: void glMultTransposeMatrixd { glMultTransposeMatrixdARB } ( GLdouble m[16] ) ;
|
||||
GL-FUNCTION: void glMultTransposeMatrixf { glMultTransposeMatrixfARB } ( GLfloat m[16] ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1d { glMultiTexCoord1dARB } ( GLenum target, GLdouble s ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1dv { glMultiTexCoord1dvARB } ( GLenum target, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1f { glMultiTexCoord1fARB } ( GLenum target, GLfloat s ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1fv { glMultiTexCoord1fvARB } ( GLenum target, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1i { glMultiTexCoord1iARB } ( GLenum target, GLint s ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1iv { glMultiTexCoord1ivARB } ( GLenum target, GLint* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1s { glMultiTexCoord1sARB } ( GLenum target, GLshort s ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord1sv { glMultiTexCoord1svARB } ( GLenum target, GLshort* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2d { glMultiTexCoord2dARB } ( GLenum target, GLdouble s, GLdouble t ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2dv { glMultiTexCoord2dvARB } ( GLenum target, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2f { glMultiTexCoord2fARB } ( GLenum target, GLfloat s, GLfloat t ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2fv { glMultiTexCoord2fvARB } ( GLenum target, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2i { glMultiTexCoord2iARB } ( GLenum target, GLint s, GLint t ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2iv { glMultiTexCoord2ivARB } ( GLenum target, GLint* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2s { glMultiTexCoord2sARB } ( GLenum target, GLshort s, GLshort t ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord2sv { glMultiTexCoord2svARB } ( GLenum target, GLshort* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3d { glMultiTexCoord3dARB } ( GLenum target, GLdouble s, GLdouble t, GLdouble r ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3dv { glMultiTexCoord3dvARB } ( GLenum target, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3f { glMultiTexCoord3fARB } ( GLenum target, GLfloat s, GLfloat t, GLfloat r ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3fv { glMultiTexCoord3fvARB } ( GLenum target, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3i { glMultiTexCoord3iARB } ( GLenum target, GLint s, GLint t, GLint r ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3iv { glMultiTexCoord3ivARB } ( GLenum target, GLint* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3s { glMultiTexCoord3sARB } ( GLenum target, GLshort s, GLshort t, GLshort r ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord3sv { glMultiTexCoord3svARB } ( GLenum target, GLshort* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4d { glMultiTexCoord4dARB } ( GLenum target, GLdouble s, GLdouble t, GLdouble r, GLdouble q ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4dv { glMultiTexCoord4dvARB } ( GLenum target, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4f { glMultiTexCoord4fARB } ( GLenum target, GLfloat s, GLfloat t, GLfloat r, GLfloat q ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4fv { glMultiTexCoord4fvARB } ( GLenum target, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4i { glMultiTexCoord4iARB } ( GLenum target, GLint s, GLint t, GLint r, GLint q ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4iv { glMultiTexCoord4ivARB } ( GLenum target, GLint* v ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4s { glMultiTexCoord4sARB } ( GLenum target, GLshort s, GLshort t, GLshort r, GLshort q ) ;
|
||||
GL-FUNCTION: void glMultiTexCoord4sv { glMultiTexCoord4svARB } ( GLenum target, GLshort* v ) ;
|
||||
GL-FUNCTION: void glSampleCoverage { glSampleCoverageARB } ( GLclampf value, GLboolean invert ) ;
|
||||
|
||||
|
||||
! OpenGL 1.4
|
||||
|
|
@ -1368,52 +1362,51 @@ GL-FUNCTION: void glSampleCoverage ( GLclampf value, GLboolean invert ) ;
|
|||
: GL_TEXTURE_COMPARE_FUNC HEX: 884D ; inline
|
||||
: GL_COMPARE_R_TO_TEXTURE HEX: 884E ; inline
|
||||
|
||||
GL-FUNCTION: void glBlendColor ( GLclampf red, GLclampf green, GLclampf blue, GLclampf alpha ) ;
|
||||
GL-FUNCTION: void glBlendEquation ( GLenum mode ) ;
|
||||
GL-FUNCTION: void glBlendFuncSeparate ( GLenum sfactorRGB, GLenum dfactorRGB, GLenum sfactorAlpha, GLenum dfactorAlpha ) ;
|
||||
GL-FUNCTION: void glFogCoordPointer ( GLenum type, GLsizei stride, GLvoid* pointer ) ;
|
||||
GL-FUNCTION: void glFogCoordd ( GLdouble coord ) ;
|
||||
GL-FUNCTION: void glFogCoorddv ( GLdouble* coord ) ;
|
||||
GL-FUNCTION: void glFogCoordf ( GLfloat coord ) ;
|
||||
GL-FUNCTION: void glFogCoordfv ( GLfloat* coord ) ;
|
||||
GL-FUNCTION: void glMultiDrawArrays ( GLenum mode, GLint* first, GLsizei* count, GLsizei primcount ) ;
|
||||
GL-FUNCTION: void glMultiDrawElements ( GLenum mode, GLsizei* count, GLenum type, GLvoid** indices, GLsizei primcount ) ;
|
||||
GL-FUNCTION: void glPointParameterf ( GLenum pname, GLfloat param ) ;
|
||||
GL-FUNCTION: void glPointParameterfv ( GLenum pname, GLfloat* params ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3b ( GLbyte red, GLbyte green, GLbyte blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3bv ( GLbyte* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3d ( GLdouble red, GLdouble green, GLdouble blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3dv ( GLdouble* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3f ( GLfloat red, GLfloat green, GLfloat blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3fv ( GLfloat* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3i ( GLint red, GLint green, GLint blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3iv ( GLint* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3s ( GLshort red, GLshort green, GLshort blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3sv ( GLshort* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3ub ( GLubyte red, GLubyte green, GLubyte blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3ubv ( GLubyte* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3ui ( GLuint red, GLuint green, GLuint blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3uiv ( GLuint* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3us ( GLushort red, GLushort green, GLushort blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3usv ( GLushort* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColorPointer ( GLint size, GLenum type, GLsizei stride, GLvoid* pointer ) ;
|
||||
GL-FUNCTION: void glWindowPos2d ( GLdouble x, GLdouble y ) ;
|
||||
GL-FUNCTION: void glWindowPos2dv ( GLdouble* p ) ;
|
||||
GL-FUNCTION: void glWindowPos2f ( GLfloat x, GLfloat y ) ;
|
||||
GL-FUNCTION: void glWindowPos2fv ( GLfloat* p ) ;
|
||||
GL-FUNCTION: void glWindowPos2i ( GLint x, GLint y ) ;
|
||||
GL-FUNCTION: void glWindowPos2iv ( GLint* p ) ;
|
||||
GL-FUNCTION: void glWindowPos2s ( GLshort x, GLshort y ) ;
|
||||
GL-FUNCTION: void glWindowPos2sv ( GLshort* p ) ;
|
||||
GL-FUNCTION: void glWindowPos3d ( GLdouble x, GLdouble y, GLdouble z ) ;
|
||||
GL-FUNCTION: void glWindowPos3dv ( GLdouble* p ) ;
|
||||
GL-FUNCTION: void glWindowPos3f ( GLfloat x, GLfloat y, GLfloat z ) ;
|
||||
GL-FUNCTION: void glWindowPos3fv ( GLfloat* p ) ;
|
||||
GL-FUNCTION: void glWindowPos3i ( GLint x, GLint y, GLint z ) ;
|
||||
GL-FUNCTION: void glWindowPos3iv ( GLint* p ) ;
|
||||
GL-FUNCTION: void glWindowPos3s ( GLshort x, GLshort y, GLshort z ) ;
|
||||
GL-FUNCTION: void glWindowPos3sv ( GLshort* p ) ;
|
||||
|
||||
GL-FUNCTION: void glBlendColor { glBlendColorEXT } ( GLclampf red, GLclampf green, GLclampf blue, GLclampf alpha ) ;
|
||||
GL-FUNCTION: void glBlendEquation { glBlendEquationEXT } ( GLenum mode ) ;
|
||||
GL-FUNCTION: void glBlendFuncSeparate { glBlendFuncSeparateEXT } ( GLenum sfactorRGB, GLenum dfactorRGB, GLenum sfactorAlpha, GLenum dfactorAlpha ) ;
|
||||
GL-FUNCTION: void glFogCoordPointer { glFogCoordPointerEXT } ( GLenum type, GLsizei stride, GLvoid* pointer ) ;
|
||||
GL-FUNCTION: void glFogCoordd { glFogCoorddEXT } ( GLdouble coord ) ;
|
||||
GL-FUNCTION: void glFogCoorddv { glFogCoorddvEXT } ( GLdouble* coord ) ;
|
||||
GL-FUNCTION: void glFogCoordf { glFogCoordfEXT } ( GLfloat coord ) ;
|
||||
GL-FUNCTION: void glFogCoordfv { glFogCoordfvEXT } ( GLfloat* coord ) ;
|
||||
GL-FUNCTION: void glMultiDrawArrays { glMultiDrawArraysEXT } ( GLenum mode, GLint* first, GLsizei* count, GLsizei primcount ) ;
|
||||
GL-FUNCTION: void glMultiDrawElements { glMultiDrawElementsEXT } ( GLenum mode, GLsizei* count, GLenum type, GLvoid** indices, GLsizei primcount ) ;
|
||||
GL-FUNCTION: void glPointParameterf { glPointParameterfARB } ( GLenum pname, GLfloat param ) ;
|
||||
GL-FUNCTION: void glPointParameterfv { glPointParameterfvARB } ( GLenum pname, GLfloat* params ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3b { glSecondaryColor3bEXT } ( GLbyte red, GLbyte green, GLbyte blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3bv { glSecondaryColor3bvEXT } ( GLbyte* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3d { glSecondaryColor3dEXT } ( GLdouble red, GLdouble green, GLdouble blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3dv { glSecondaryColor3dvEXT } ( GLdouble* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3f { glSecondaryColor3fEXT } ( GLfloat red, GLfloat green, GLfloat blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3fv { glSecondaryColor3fvEXT } ( GLfloat* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3i { glSecondaryColor3iEXT } ( GLint red, GLint green, GLint blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3iv { glSecondaryColor3ivEXT } ( GLint* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3s { glSecondaryColor3sEXT } ( GLshort red, GLshort green, GLshort blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3sv { glSecondaryColor3svEXT } ( GLshort* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3ub { glSecondaryColor3ubEXT } ( GLubyte red, GLubyte green, GLubyte blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3ubv { glSecondaryColor3ubvEXT } ( GLubyte* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3ui { glSecondaryColor3uiEXT } ( GLuint red, GLuint green, GLuint blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3uiv { glSecondaryColor3uivEXT } ( GLuint* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3us { glSecondaryColor3usEXT } ( GLushort red, GLushort green, GLushort blue ) ;
|
||||
GL-FUNCTION: void glSecondaryColor3usv { glSecondaryColor3usvEXT } ( GLushort* v ) ;
|
||||
GL-FUNCTION: void glSecondaryColorPointer { glSecondaryColorPointerEXT } ( GLint size, GLenum type, GLsizei stride, GLvoid* pointer ) ;
|
||||
GL-FUNCTION: void glWindowPos2d { glWindowPos2dARB } ( GLdouble x, GLdouble y ) ;
|
||||
GL-FUNCTION: void glWindowPos2dv { glWindowPos2dvARB } ( GLdouble* p ) ;
|
||||
GL-FUNCTION: void glWindowPos2f { glWindowPos2fARB } ( GLfloat x, GLfloat y ) ;
|
||||
GL-FUNCTION: void glWindowPos2fv { glWindowPos2fvARB } ( GLfloat* p ) ;
|
||||
GL-FUNCTION: void glWindowPos2i { glWindowPos2iARB } ( GLint x, GLint y ) ;
|
||||
GL-FUNCTION: void glWindowPos2iv { glWindowPos2ivARB } ( GLint* p ) ;
|
||||
GL-FUNCTION: void glWindowPos2s { glWindowPos2sARB } ( GLshort x, GLshort y ) ;
|
||||
GL-FUNCTION: void glWindowPos2sv { glWindowPos2svARB } ( GLshort* p ) ;
|
||||
GL-FUNCTION: void glWindowPos3d { glWindowPos3dARB } ( GLdouble x, GLdouble y, GLdouble z ) ;
|
||||
GL-FUNCTION: void glWindowPos3dv { glWindowPos3dvARB } ( GLdouble* p ) ;
|
||||
GL-FUNCTION: void glWindowPos3f { glWindowPos3fARB } ( GLfloat x, GLfloat y, GLfloat z ) ;
|
||||
GL-FUNCTION: void glWindowPos3fv { glWindowPos3fvARB } ( GLfloat* p ) ;
|
||||
GL-FUNCTION: void glWindowPos3i { glWindowPos3iARB } ( GLint x, GLint y, GLint z ) ;
|
||||
GL-FUNCTION: void glWindowPos3iv { glWindowPos3ivARB } ( GLint* p ) ;
|
||||
GL-FUNCTION: void glWindowPos3s { glWindowPos3sARB } ( GLshort x, GLshort y, GLshort z ) ;
|
||||
GL-FUNCTION: void glWindowPos3sv { glWindowPos3svARB } ( GLshort* p ) ;
|
||||
|
||||
! OpenGL 1.5
|
||||
|
||||
|
|
@ -1471,25 +1464,25 @@ GL-FUNCTION: void glWindowPos3sv ( GLshort* p ) ;
|
|||
TYPEDEF: ptrdiff_t GLsizeiptr
|
||||
TYPEDEF: ptrdiff_t GLintptr
|
||||
|
||||
GL-FUNCTION: void glBeginQuery ( GLenum target, GLuint id ) ;
|
||||
GL-FUNCTION: void glBindBuffer ( GLenum target, GLuint buffer ) ;
|
||||
GL-FUNCTION: void glBufferData ( GLenum target, GLsizeiptr size, GLvoid* data, GLenum usage ) ;
|
||||
GL-FUNCTION: void glBufferSubData ( GLenum target, GLintptr offset, GLsizeiptr size, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glDeleteBuffers ( GLsizei n, GLuint* buffers ) ;
|
||||
GL-FUNCTION: void glDeleteQueries ( GLsizei n, GLuint* ids ) ;
|
||||
GL-FUNCTION: void glEndQuery ( GLenum target ) ;
|
||||
GL-FUNCTION: void glGenBuffers ( GLsizei n, GLuint* buffers ) ;
|
||||
GL-FUNCTION: void glGenQueries ( GLsizei n, GLuint* ids ) ;
|
||||
GL-FUNCTION: void glGetBufferParameteriv ( GLenum target, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: void glGetBufferPointerv ( GLenum target, GLenum pname, GLvoid** params ) ;
|
||||
GL-FUNCTION: void glGetBufferSubData ( GLenum target, GLintptr offset, GLsizeiptr size, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glGetQueryObjectiv ( GLuint id, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: void glGetQueryObjectuiv ( GLuint id, GLenum pname, GLuint* params ) ;
|
||||
GL-FUNCTION: void glGetQueryiv ( GLenum target, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: GLboolean glIsBuffer ( GLuint buffer ) ;
|
||||
GL-FUNCTION: GLboolean glIsQuery ( GLuint id ) ;
|
||||
GL-FUNCTION: GLvoid* glMapBuffer ( GLenum target, GLenum access ) ;
|
||||
GL-FUNCTION: GLboolean glUnmapBuffer ( GLenum target ) ;
|
||||
GL-FUNCTION: void glBeginQuery { glBeginQueryARB } ( GLenum target, GLuint id ) ;
|
||||
GL-FUNCTION: void glBindBuffer { glBindBufferARB } ( GLenum target, GLuint buffer ) ;
|
||||
GL-FUNCTION: void glBufferData { glBufferDataARB } ( GLenum target, GLsizeiptr size, GLvoid* data, GLenum usage ) ;
|
||||
GL-FUNCTION: void glBufferSubData { glBufferSubDataARB } ( GLenum target, GLintptr offset, GLsizeiptr size, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glDeleteBuffers { glDeleteBuffersARB } ( GLsizei n, GLuint* buffers ) ;
|
||||
GL-FUNCTION: void glDeleteQueries { glDeleteQueriesARB } ( GLsizei n, GLuint* ids ) ;
|
||||
GL-FUNCTION: void glEndQuery { glEndQueryARB } ( GLenum target ) ;
|
||||
GL-FUNCTION: void glGenBuffers { glGenBuffersARB } ( GLsizei n, GLuint* buffers ) ;
|
||||
GL-FUNCTION: void glGenQueries { glGenQueriesARB } ( GLsizei n, GLuint* ids ) ;
|
||||
GL-FUNCTION: void glGetBufferParameteriv { glGetBufferParameterivARB } ( GLenum target, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: void glGetBufferPointerv { glGetBufferPointervARB } ( GLenum target, GLenum pname, GLvoid** params ) ;
|
||||
GL-FUNCTION: void glGetBufferSubData { glGetBufferSubDataARB } ( GLenum target, GLintptr offset, GLsizeiptr size, GLvoid* data ) ;
|
||||
GL-FUNCTION: void glGetQueryObjectiv { glGetQueryObjectivARB } ( GLuint id, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: void glGetQueryObjectuiv { glGetQueryObjectuivARB } ( GLuint id, GLenum pname, GLuint* params ) ;
|
||||
GL-FUNCTION: void glGetQueryiv { glGetQueryivARB } ( GLenum target, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: GLboolean glIsBuffer { glIsBufferARB } ( GLuint buffer ) ;
|
||||
GL-FUNCTION: GLboolean glIsQuery { glIsQueryARB } ( GLuint id ) ;
|
||||
GL-FUNCTION: GLvoid* glMapBuffer { glMapBufferARB } ( GLenum target, GLenum access ) ;
|
||||
GL-FUNCTION: GLboolean glUnmapBuffer { glUnmapBufferARB } ( GLenum target ) ;
|
||||
|
||||
|
||||
! OpenGL 2.0
|
||||
|
|
@ -1583,99 +1576,99 @@ GL-FUNCTION: GLboolean glUnmapBuffer ( GLenum target ) ;
|
|||
|
||||
TYPEDEF: char GLchar
|
||||
|
||||
GL-FUNCTION: void glAttachShader ( GLuint program, GLuint shader ) ;
|
||||
GL-FUNCTION: void glBindAttribLocation ( GLuint program, GLuint index, GLchar* name ) ;
|
||||
GL-FUNCTION: void glBlendEquationSeparate ( GLenum modeRGB, GLenum modeAlpha ) ;
|
||||
GL-FUNCTION: void glCompileShader ( GLuint shader ) ;
|
||||
GL-FUNCTION: GLuint glCreateProgram ( ) ;
|
||||
GL-FUNCTION: GLuint glCreateShader ( GLenum type ) ;
|
||||
GL-FUNCTION: void glDeleteProgram ( GLuint program ) ;
|
||||
GL-FUNCTION: void glDeleteShader ( GLuint shader ) ;
|
||||
GL-FUNCTION: void glDetachShader ( GLuint program, GLuint shader ) ;
|
||||
GL-FUNCTION: void glDisableVertexAttribArray ( GLuint index ) ;
|
||||
GL-FUNCTION: void glDrawBuffers ( GLsizei n, GLenum* bufs ) ;
|
||||
GL-FUNCTION: void glEnableVertexAttribArray ( GLuint index ) ;
|
||||
GL-FUNCTION: void glGetActiveAttrib ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
|
||||
GL-FUNCTION: void glGetActiveUniform ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
|
||||
GL-FUNCTION: void glGetAttachedShaders ( GLuint program, GLsizei maxCount, GLsizei* count, GLuint* shaders ) ;
|
||||
GL-FUNCTION: GLint glGetAttribLocation ( GLuint program, GLchar* name ) ;
|
||||
GL-FUNCTION: void glGetProgramInfoLog ( GLuint program, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
|
||||
GL-FUNCTION: void glGetProgramiv ( GLuint program, GLenum pname, GLint* param ) ;
|
||||
GL-FUNCTION: void glGetShaderInfoLog ( GLuint shader, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
|
||||
GL-FUNCTION: void glGetShaderSource ( GLint obj, GLsizei maxLength, GLsizei* length, GLchar* source ) ;
|
||||
GL-FUNCTION: void glGetShaderiv ( GLuint shader, GLenum pname, GLint* param ) ;
|
||||
GL-FUNCTION: GLint glGetUniformLocation ( GLint programObj, GLchar* name ) ;
|
||||
GL-FUNCTION: void glGetUniformfv ( GLuint program, GLint location, GLfloat* params ) ;
|
||||
GL-FUNCTION: void glGetUniformiv ( GLuint program, GLint location, GLint* params ) ;
|
||||
GL-FUNCTION: void glGetVertexAttribPointerv ( GLuint index, GLenum pname, GLvoid** pointer ) ;
|
||||
GL-FUNCTION: void glGetVertexAttribdv ( GLuint index, GLenum pname, GLdouble* params ) ;
|
||||
GL-FUNCTION: void glGetVertexAttribfv ( GLuint index, GLenum pname, GLfloat* params ) ;
|
||||
GL-FUNCTION: void glGetVertexAttribiv ( GLuint index, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: GLboolean glIsProgram ( GLuint program ) ;
|
||||
GL-FUNCTION: GLboolean glIsShader ( GLuint shader ) ;
|
||||
GL-FUNCTION: void glLinkProgram ( GLuint program ) ;
|
||||
GL-FUNCTION: void glShaderSource ( GLuint shader, GLsizei count, GLchar** strings, GLint* lengths ) ;
|
||||
GL-FUNCTION: void glStencilFuncSeparate ( GLenum frontfunc, GLenum backfunc, GLint ref, GLuint mask ) ;
|
||||
GL-FUNCTION: void glStencilMaskSeparate ( GLenum face, GLuint mask ) ;
|
||||
GL-FUNCTION: void glStencilOpSeparate ( GLenum face, GLenum sfail, GLenum dpfail, GLenum dppass ) ;
|
||||
GL-FUNCTION: void glUniform1f ( GLint location, GLfloat v0 ) ;
|
||||
GL-FUNCTION: void glUniform1fv ( GLint location, GLsizei count, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniform1i ( GLint location, GLint v0 ) ;
|
||||
GL-FUNCTION: void glUniform1iv ( GLint location, GLsizei count, GLint* value ) ;
|
||||
GL-FUNCTION: void glUniform2f ( GLint location, GLfloat v0, GLfloat v1 ) ;
|
||||
GL-FUNCTION: void glUniform2fv ( GLint location, GLsizei count, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniform2i ( GLint location, GLint v0, GLint v1 ) ;
|
||||
GL-FUNCTION: void glUniform2iv ( GLint location, GLsizei count, GLint* value ) ;
|
||||
GL-FUNCTION: void glUniform3f ( GLint location, GLfloat v0, GLfloat v1, GLfloat v2 ) ;
|
||||
GL-FUNCTION: void glUniform3fv ( GLint location, GLsizei count, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniform3i ( GLint location, GLint v0, GLint v1, GLint v2 ) ;
|
||||
GL-FUNCTION: void glUniform3iv ( GLint location, GLsizei count, GLint* value ) ;
|
||||
GL-FUNCTION: void glUniform4f ( GLint location, GLfloat v0, GLfloat v1, GLfloat v2, GLfloat v3 ) ;
|
||||
GL-FUNCTION: void glUniform4fv ( GLint location, GLsizei count, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniform4i ( GLint location, GLint v0, GLint v1, GLint v2, GLint v3 ) ;
|
||||
GL-FUNCTION: void glUniform4iv ( GLint location, GLsizei count, GLint* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix2fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix3fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix4fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUseProgram ( GLuint program ) ;
|
||||
GL-FUNCTION: void glValidateProgram ( GLuint program ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1d ( GLuint index, GLdouble x ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1dv ( GLuint index, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1f ( GLuint index, GLfloat x ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1fv ( GLuint index, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1s ( GLuint index, GLshort x ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1sv ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2d ( GLuint index, GLdouble x, GLdouble y ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2dv ( GLuint index, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2f ( GLuint index, GLfloat x, GLfloat y ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2fv ( GLuint index, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2s ( GLuint index, GLshort x, GLshort y ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2sv ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3d ( GLuint index, GLdouble x, GLdouble y, GLdouble z ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3dv ( GLuint index, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3f ( GLuint index, GLfloat x, GLfloat y, GLfloat z ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3fv ( GLuint index, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3s ( GLuint index, GLshort x, GLshort y, GLshort z ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3sv ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nbv ( GLuint index, GLbyte* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Niv ( GLuint index, GLint* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nsv ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nub ( GLuint index, GLubyte x, GLubyte y, GLubyte z, GLubyte w ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nubv ( GLuint index, GLubyte* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nuiv ( GLuint index, GLuint* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nusv ( GLuint index, GLushort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4bv ( GLuint index, GLbyte* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4d ( GLuint index, GLdouble x, GLdouble y, GLdouble z, GLdouble w ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4dv ( GLuint index, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4f ( GLuint index, GLfloat x, GLfloat y, GLfloat z, GLfloat w ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4fv ( GLuint index, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4iv ( GLuint index, GLint* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4s ( GLuint index, GLshort x, GLshort y, GLshort z, GLshort w ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4sv ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4ubv ( GLuint index, GLubyte* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4uiv ( GLuint index, GLuint* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4usv ( GLuint index, GLushort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttribPointer ( GLuint index, GLint size, GLenum type, GLboolean normalized, GLsizei stride, GLvoid* pointer ) ;
|
||||
GL-FUNCTION: void glAttachShader { glAttachObjectARB } ( GLuint program, GLuint shader ) ;
|
||||
GL-FUNCTION: void glBindAttribLocation { glBindAttribLocationARB } ( GLuint program, GLuint index, GLchar* name ) ;
|
||||
GL-FUNCTION: void glBlendEquationSeparate { glBlendEquationSeparateEXT } ( GLenum modeRGB, GLenum modeAlpha ) ;
|
||||
GL-FUNCTION: void glCompileShader { glCompileShaderARB } ( GLuint shader ) ;
|
||||
GL-FUNCTION: GLuint glCreateProgram { glCreateProgramObjectARB } ( ) ;
|
||||
GL-FUNCTION: GLuint glCreateShader { glCreateShaderObjectARB } ( GLenum type ) ;
|
||||
GL-FUNCTION: void glDeleteProgram { glDeleteObjectARB } ( GLuint program ) ;
|
||||
GL-FUNCTION: void glDeleteShader { glDeleteObjectARB } ( GLuint shader ) ;
|
||||
GL-FUNCTION: void glDetachShader { glDetachObjectARB } ( GLuint program, GLuint shader ) ;
|
||||
GL-FUNCTION: void glDisableVertexAttribArray { glDisableVertexAttribArrayARB } ( GLuint index ) ;
|
||||
GL-FUNCTION: void glDrawBuffers { glDrawBuffersARB glDrawBuffersATI } ( GLsizei n, GLenum* bufs ) ;
|
||||
GL-FUNCTION: void glEnableVertexAttribArray { glEnableVertexAttribArrayARB } ( GLuint index ) ;
|
||||
GL-FUNCTION: void glGetActiveAttrib { glGetActiveAttribARB } ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
|
||||
GL-FUNCTION: void glGetActiveUniform { glGetActiveUniformARB } ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
|
||||
GL-FUNCTION: void glGetAttachedShaders { glGetAttachedObjectsARB } ( GLuint program, GLsizei maxCount, GLsizei* count, GLuint* shaders ) ;
|
||||
GL-FUNCTION: GLint glGetAttribLocation { glGetAttribLocationARB } ( GLuint program, GLchar* name ) ;
|
||||
GL-FUNCTION: void glGetProgramInfoLog { glGetInfoLogARB } ( GLuint program, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
|
||||
GL-FUNCTION: void glGetProgramiv { glGetObjectParameterivARB } ( GLuint program, GLenum pname, GLint* param ) ;
|
||||
GL-FUNCTION: void glGetShaderInfoLog { glGetInfoLogARB } ( GLuint shader, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
|
||||
GL-FUNCTION: void glGetShaderSource { glGetShaderSourceARB } ( GLint obj, GLsizei maxLength, GLsizei* length, GLchar* source ) ;
|
||||
GL-FUNCTION: void glGetShaderiv { glGetObjectParameterivARB } ( GLuint shader, GLenum pname, GLint* param ) ;
|
||||
GL-FUNCTION: GLint glGetUniformLocation { glGetUniformLocationARB } ( GLint programObj, GLchar* name ) ;
|
||||
GL-FUNCTION: void glGetUniformfv { glGetUniformfvARB } ( GLuint program, GLint location, GLfloat* params ) ;
|
||||
GL-FUNCTION: void glGetUniformiv { glGetUniformivARB } ( GLuint program, GLint location, GLint* params ) ;
|
||||
GL-FUNCTION: void glGetVertexAttribPointerv { glGetVertexAttribPointervARB } ( GLuint index, GLenum pname, GLvoid** pointer ) ;
|
||||
GL-FUNCTION: void glGetVertexAttribdv { glGetVertexAttribdvARB } ( GLuint index, GLenum pname, GLdouble* params ) ;
|
||||
GL-FUNCTION: void glGetVertexAttribfv { glGetVertexAttribfvARB } ( GLuint index, GLenum pname, GLfloat* params ) ;
|
||||
GL-FUNCTION: void glGetVertexAttribiv { glGetVertexAttribivARB } ( GLuint index, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: GLboolean glIsProgram { glIsProgramARB } ( GLuint program ) ;
|
||||
GL-FUNCTION: GLboolean glIsShader { glIsShaderARB } ( GLuint shader ) ;
|
||||
GL-FUNCTION: void glLinkProgram { glLinkProgramARB } ( GLuint program ) ;
|
||||
GL-FUNCTION: void glShaderSource { glShaderSourceARB } ( GLuint shader, GLsizei count, GLchar** strings, GLint* lengths ) ;
|
||||
GL-FUNCTION: void glStencilFuncSeparate { glStencilFuncSeparateATI } ( GLenum frontfunc, GLenum backfunc, GLint ref, GLuint mask ) ;
|
||||
GL-FUNCTION: void glStencilMaskSeparate { } ( GLenum face, GLuint mask ) ;
|
||||
GL-FUNCTION: void glStencilOpSeparate { glStencilOpSeparateATI } ( GLenum face, GLenum sfail, GLenum dpfail, GLenum dppass ) ;
|
||||
GL-FUNCTION: void glUniform1f { glUniform1fARB } ( GLint location, GLfloat v0 ) ;
|
||||
GL-FUNCTION: void glUniform1fv { glUniform1fvARB } ( GLint location, GLsizei count, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniform1i { glUniform1iARB } ( GLint location, GLint v0 ) ;
|
||||
GL-FUNCTION: void glUniform1iv { glUniform1ivARB } ( GLint location, GLsizei count, GLint* value ) ;
|
||||
GL-FUNCTION: void glUniform2f { glUniform2fARB } ( GLint location, GLfloat v0, GLfloat v1 ) ;
|
||||
GL-FUNCTION: void glUniform2fv { glUniform2fvARB } ( GLint location, GLsizei count, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniform2i { glUniform2iARB } ( GLint location, GLint v0, GLint v1 ) ;
|
||||
GL-FUNCTION: void glUniform2iv { glUniform2ivARB } ( GLint location, GLsizei count, GLint* value ) ;
|
||||
GL-FUNCTION: void glUniform3f { glUniform3fARB } ( GLint location, GLfloat v0, GLfloat v1, GLfloat v2 ) ;
|
||||
GL-FUNCTION: void glUniform3fv { glUniform3fvARB } ( GLint location, GLsizei count, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniform3i { glUniform3iARB } ( GLint location, GLint v0, GLint v1, GLint v2 ) ;
|
||||
GL-FUNCTION: void glUniform3iv { glUniform3ivARB } ( GLint location, GLsizei count, GLint* value ) ;
|
||||
GL-FUNCTION: void glUniform4f { glUniform4fARB } ( GLint location, GLfloat v0, GLfloat v1, GLfloat v2, GLfloat v3 ) ;
|
||||
GL-FUNCTION: void glUniform4fv { glUniform4fvARB } ( GLint location, GLsizei count, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniform4i { glUniform4iARB } ( GLint location, GLint v0, GLint v1, GLint v2, GLint v3 ) ;
|
||||
GL-FUNCTION: void glUniform4iv { glUniform4ivARB } ( GLint location, GLsizei count, GLint* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix2fv { glUniformMatrix2fvARB } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix3fv { glUniformMatrix3fvARB } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix4fv { glUniformMatrix4fvARB } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUseProgram { glUseProgramObjectARB } ( GLuint program ) ;
|
||||
GL-FUNCTION: void glValidateProgram { glValidateProgramARB } ( GLuint program ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1d { glVertexAttrib1dARB } ( GLuint index, GLdouble x ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1dv { glVertexAttrib1dvARB } ( GLuint index, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1f { glVertexAttrib1fARB } ( GLuint index, GLfloat x ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1fv { glVertexAttrib1fvARB } ( GLuint index, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1s { glVertexAttrib1sARB } ( GLuint index, GLshort x ) ;
|
||||
GL-FUNCTION: void glVertexAttrib1sv { glVertexAttrib1svARB } ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2d { glVertexAttrib2dARB } ( GLuint index, GLdouble x, GLdouble y ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2dv { glVertexAttrib2dvARB } ( GLuint index, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2f { glVertexAttrib2fARB } ( GLuint index, GLfloat x, GLfloat y ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2fv { glVertexAttrib2fvARB } ( GLuint index, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2s { glVertexAttrib2sARB } ( GLuint index, GLshort x, GLshort y ) ;
|
||||
GL-FUNCTION: void glVertexAttrib2sv { glVertexAttrib2svARB } ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3d { glVertexAttrib3dARB } ( GLuint index, GLdouble x, GLdouble y, GLdouble z ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3dv { glVertexAttrib3dvARB } ( GLuint index, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3f { glVertexAttrib3fARB } ( GLuint index, GLfloat x, GLfloat y, GLfloat z ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3fv { glVertexAttrib3fvARB } ( GLuint index, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3s { glVertexAttrib3sARB } ( GLuint index, GLshort x, GLshort y, GLshort z ) ;
|
||||
GL-FUNCTION: void glVertexAttrib3sv { glVertexAttrib3svARB } ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nbv { glVertexAttrib4NbvARB } ( GLuint index, GLbyte* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Niv { glVertexAttrib4NivARB } ( GLuint index, GLint* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nsv { glVertexAttrib4NsvARB } ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nub { glVertexAttrib4NubARB } ( GLuint index, GLubyte x, GLubyte y, GLubyte z, GLubyte w ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nubv { glVertexAttrib4NubvARB } ( GLuint index, GLubyte* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nuiv { glVertexAttrib4NuivARB } ( GLuint index, GLuint* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4Nusv { glVertexAttrib4NusvARB } ( GLuint index, GLushort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4bv { glVertexAttrib4bvARB } ( GLuint index, GLbyte* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4d { glVertexAttrib4dARB } ( GLuint index, GLdouble x, GLdouble y, GLdouble z, GLdouble w ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4dv { glVertexAttrib4dvARB } ( GLuint index, GLdouble* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4f { glVertexAttrib4fARB } ( GLuint index, GLfloat x, GLfloat y, GLfloat z, GLfloat w ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4fv { glVertexAttrib4fvARB } ( GLuint index, GLfloat* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4iv { glVertexAttrib4ivARB } ( GLuint index, GLint* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4s { glVertexAttrib4sARB } ( GLuint index, GLshort x, GLshort y, GLshort z, GLshort w ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4sv { glVertexAttrib4svARB } ( GLuint index, GLshort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4ubv { glVertexAttrib4ubvARB } ( GLuint index, GLubyte* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4uiv { glVertexAttrib4uivARB } ( GLuint index, GLuint* v ) ;
|
||||
GL-FUNCTION: void glVertexAttrib4usv { glVertexAttrib4usvARB } ( GLuint index, GLushort* v ) ;
|
||||
GL-FUNCTION: void glVertexAttribPointer { glVertexAttribPointerARB } ( GLuint index, GLint size, GLenum type, GLboolean normalized, GLsizei stride, GLvoid* pointer ) ;
|
||||
|
||||
|
||||
! OpenGL 2.1
|
||||
|
|
@ -1699,12 +1692,12 @@ GL-FUNCTION: void glVertexAttribPointer ( GLuint index, GLint size, GLenum type,
|
|||
: GL_COMPRESSED_SLUMINANCE HEX: 8C4A ; inline
|
||||
: GL_COMPRESSED_SLUMINANCE_ALPHA HEX: 8C4B ; inline
|
||||
|
||||
GL-FUNCTION: void glUniformMatrix2x3fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix2x4fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix3x2fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix3x4fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix4x2fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix4x3fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix2x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix2x4fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix3x2fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix3x4fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix4x2fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
GL-FUNCTION: void glUniformMatrix4x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
|
||||
|
||||
|
||||
! GL_EXT_framebuffer_object
|
||||
|
|
@ -1762,23 +1755,23 @@ GL-FUNCTION: void glUniformMatrix4x3fv ( GLint location, GLsizei count, GLboolea
|
|||
: GL_RENDERBUFFER_DEPTH_SIZE_EXT HEX: 8D54 ; inline
|
||||
: GL_RENDERBUFFER_STENCIL_SIZE_EXT HEX: 8D55 ; inline
|
||||
|
||||
GL-FUNCTION: void glBindFramebufferEXT ( GLenum target, GLuint framebuffer ) ;
|
||||
GL-FUNCTION: void glBindRenderbufferEXT ( GLenum target, GLuint renderbuffer ) ;
|
||||
GL-FUNCTION: GLenum glCheckFramebufferStatusEXT ( GLenum target ) ;
|
||||
GL-FUNCTION: void glDeleteFramebuffersEXT ( GLsizei n, GLuint* framebuffers ) ;
|
||||
GL-FUNCTION: void glDeleteRenderbuffersEXT ( GLsizei n, GLuint* renderbuffers ) ;
|
||||
GL-FUNCTION: void glFramebufferRenderbufferEXT ( GLenum target, GLenum attachment, GLenum renderbuffertarget, GLuint renderbuffer ) ;
|
||||
GL-FUNCTION: void glFramebufferTexture1DEXT ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
|
||||
GL-FUNCTION: void glFramebufferTexture2DEXT ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
|
||||
GL-FUNCTION: void glFramebufferTexture3DEXT ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level, GLint zoffset ) ;
|
||||
GL-FUNCTION: void glGenFramebuffersEXT ( GLsizei n, GLuint* framebuffers ) ;
|
||||
GL-FUNCTION: void glGenRenderbuffersEXT ( GLsizei n, GLuint* renderbuffers ) ;
|
||||
GL-FUNCTION: void glGenerateMipmapEXT ( GLenum target ) ;
|
||||
GL-FUNCTION: void glGetFramebufferAttachmentParameterivEXT ( GLenum target, GLenum attachment, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: void glGetRenderbufferParameterivEXT ( GLenum target, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: GLboolean glIsFramebufferEXT ( GLuint framebuffer ) ;
|
||||
GL-FUNCTION: GLboolean glIsRenderbufferEXT ( GLuint renderbuffer ) ;
|
||||
GL-FUNCTION: void glRenderbufferStorageEXT ( GLenum target, GLenum internalformat, GLsizei width, GLsizei height ) ;
|
||||
GL-FUNCTION: void glBindFramebufferEXT { } ( GLenum target, GLuint framebuffer ) ;
|
||||
GL-FUNCTION: void glBindRenderbufferEXT { } ( GLenum target, GLuint renderbuffer ) ;
|
||||
GL-FUNCTION: GLenum glCheckFramebufferStatusEXT { } ( GLenum target ) ;
|
||||
GL-FUNCTION: void glDeleteFramebuffersEXT { } ( GLsizei n, GLuint* framebuffers ) ;
|
||||
GL-FUNCTION: void glDeleteRenderbuffersEXT { } ( GLsizei n, GLuint* renderbuffers ) ;
|
||||
GL-FUNCTION: void glFramebufferRenderbufferEXT { } ( GLenum target, GLenum attachment, GLenum renderbuffertarget, GLuint renderbuffer ) ;
|
||||
GL-FUNCTION: void glFramebufferTexture1DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
|
||||
GL-FUNCTION: void glFramebufferTexture2DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
|
||||
GL-FUNCTION: void glFramebufferTexture3DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level, GLint zoffset ) ;
|
||||
GL-FUNCTION: void glGenFramebuffersEXT { } ( GLsizei n, GLuint* framebuffers ) ;
|
||||
GL-FUNCTION: void glGenRenderbuffersEXT { } ( GLsizei n, GLuint* renderbuffers ) ;
|
||||
GL-FUNCTION: void glGenerateMipmapEXT { } ( GLenum target ) ;
|
||||
GL-FUNCTION: void glGetFramebufferAttachmentParameterivEXT { } ( GLenum target, GLenum attachment, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: void glGetRenderbufferParameterivEXT { } ( GLenum target, GLenum pname, GLint* params ) ;
|
||||
GL-FUNCTION: GLboolean glIsFramebufferEXT { } ( GLuint framebuffer ) ;
|
||||
GL-FUNCTION: GLboolean glIsRenderbufferEXT { } ( GLuint renderbuffer ) ;
|
||||
GL-FUNCTION: void glRenderbufferStorageEXT { } ( GLenum target, GLenum internalformat, GLsizei width, GLsizei height ) ;
|
||||
|
||||
|
||||
! GL_ARB_texture_float
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
USING: kernel alien ;
|
||||
IN: opengl.gl.macosx
|
||||
|
||||
: gl-function-context ( -- context ) 0 ; inline
|
||||
: gl-function-address ( name -- address ) "gl" load-library dlsym ; inline
|
||||
: gl-function-calling-convention ( -- str ) "cdecl" ; inline
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
USING: alien.syntax kernel syntax words ;
|
||||
|
||||
USING: kernel x11.glx ;
|
||||
IN: opengl.gl.unix
|
||||
|
||||
: GL-FUNCTION: POSTPONE: FUNCTION: ; parsing
|
||||
: gl-function-context ( -- context ) glXGetCurrentContext ; inline
|
||||
: gl-function-address ( name -- address ) glXGetProcAddressARB ; inline
|
||||
: gl-function-calling-convention ( -- str ) "cdecl" ; inline
|
||||
|
|
|
|||
|
|
@ -1,34 +1,6 @@
|
|||
USING: alien alien.syntax arrays assocs hashtables init kernel
|
||||
libc math namespaces parser sequences syntax system vectors
|
||||
windows.opengl32 ;
|
||||
|
||||
USING: kernel windows.opengl32 ;
|
||||
IN: opengl.gl.windows
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: gl-function-number-counter
|
||||
SYMBOL: gl-function-pointers
|
||||
|
||||
0 gl-function-number-counter set
|
||||
[ 100 <hashtable> gl-function-pointers set ] "opengl.gl.windows init hook" add-init-hook
|
||||
|
||||
: gl-function-number ( -- n )
|
||||
gl-function-number-counter get
|
||||
dup 1+ gl-function-number-counter set ;
|
||||
|
||||
: gl-function-pointer ( name n -- funptr )
|
||||
wglGetCurrentContext 2array dup gl-function-pointers get at
|
||||
[ -rot 2drop ]
|
||||
[ >r wglGetProcAddress dup r> gl-function-pointers get set-at ]
|
||||
if* ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: GL-FUNCTION:
|
||||
"stdcall"
|
||||
scan
|
||||
scan
|
||||
dup gl-function-number [ gl-function-pointer ] 2curry swap
|
||||
";" parse-tokens [ "()" subseq? not ] subset
|
||||
define-indirect
|
||||
; parsing
|
||||
: gl-function-context ( -- context ) wglGetCurrentContext ; inline
|
||||
: gl-function-address ( name -- address ) wglGetProcAddress ; inline
|
||||
: gl-function-calling-convention ( -- str ) "stdcall" ; inline
|
||||
|
|
|
|||
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: classes inference inference.dataflow io kernel
|
||||
kernel.private math.parser namespaces optimizer prettyprint
|
||||
prettyprint.backend sequences words arrays match macros
|
||||
assocs sequences.private ;
|
||||
assocs sequences.private optimizer.specializers generic
|
||||
combinators sorting math ;
|
||||
IN: optimizer.debugger
|
||||
|
||||
! A simple tool for turning dataflow IR into quotations, for
|
||||
|
|
@ -113,7 +114,62 @@ M: object node>quot dup class word-name comment, ;
|
|||
: dataflow>quot ( node ? -- quot )
|
||||
[ swap (dataflow>quot) ] [ ] make ;
|
||||
|
||||
: print-dataflow ( quot ? -- )
|
||||
: optimized-quot. ( quot ? -- )
|
||||
#! Print dataflow IR for a quotation. Flag indicates if
|
||||
#! annotations should be printed or not.
|
||||
>r dataflow optimize r> dataflow>quot pprint nl ;
|
||||
|
||||
: optimized-word. ( word ? -- ) >r specialized-def r> optimized-quot. ;
|
||||
|
||||
SYMBOL: words-called
|
||||
SYMBOL: generics-called
|
||||
SYMBOL: methods-called
|
||||
SYMBOL: intrinsics-called
|
||||
SYMBOL: node-count
|
||||
|
||||
: dataflow>report ( node -- alist )
|
||||
[
|
||||
H{ } clone words-called set
|
||||
H{ } clone generics-called set
|
||||
H{ } clone methods-called set
|
||||
H{ } clone intrinsics-called set
|
||||
|
||||
0 swap [
|
||||
>r 1+ r>
|
||||
dup #call? [
|
||||
node-param {
|
||||
{ [ dup "intrinsics" word-prop over "if-intrinsics" word-prop or ] [ intrinsics-called ] }
|
||||
{ [ dup generic? ] [ generics-called ] }
|
||||
{ [ dup method-body? ] [ methods-called ] }
|
||||
{ [ t ] [ words-called ] }
|
||||
} cond 1 -rot get at+
|
||||
] [
|
||||
drop
|
||||
] if
|
||||
] each-node
|
||||
node-count set
|
||||
] H{ } make-assoc ;
|
||||
|
||||
: quot-optimize-report ( quot -- report )
|
||||
dataflow optimize dataflow>report ;
|
||||
|
||||
: word-optimize-report ( word -- report )
|
||||
word-def quot-optimize-report ;
|
||||
|
||||
: report. ( report -- )
|
||||
[
|
||||
"==== Total number of dataflow nodes:" print
|
||||
node-count get .
|
||||
|
||||
{
|
||||
{ generics-called "==== Generic word calls:" }
|
||||
{ words-called "==== Ordinary word calls:" }
|
||||
{ methods-called "==== Non-inlined method calls:" }
|
||||
{ intrinsics-called "==== Open-coded intrinsic calls:" }
|
||||
} [
|
||||
nl print get keys natural-sort stack.
|
||||
] assoc-each
|
||||
] bind ;
|
||||
|
||||
: optimizer-report. ( word -- )
|
||||
word-optimize-report report. ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: hashtables kernel math math.parser math.ranges project-euler.common
|
||||
sequences sorting ;
|
||||
USING: hashtables kernel math math.ranges project-euler.common sequences
|
||||
sorting ;
|
||||
IN: project-euler.004
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=4
|
||||
|
|
@ -18,9 +18,6 @@ IN: project-euler.004
|
|||
! SOLUTION
|
||||
! --------
|
||||
|
||||
: palindrome? ( n -- ? )
|
||||
number>string dup reverse = ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: source-004 ( -- seq )
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math.ranges math.text.english sequences strings
|
||||
ascii ;
|
||||
USING: kernel math.ranges math.text.english sequences sequences.lib strings
|
||||
ascii ;
|
||||
IN: project-euler.017
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=17
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: calendar combinators combinators.lib kernel math math.ranges namespaces
|
||||
sequences ;
|
||||
USING: calendar combinators kernel math math.ranges namespaces sequences
|
||||
sequences.lib ;
|
||||
IN: project-euler.019
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=19
|
||||
|
|
@ -32,7 +32,7 @@ IN: project-euler.019
|
|||
|
||||
: euler019 ( -- answer )
|
||||
1901 2000 [a,b] [
|
||||
12 [1,b] [ 1 zeller-congruence ] 1 map-withn
|
||||
12 [1,b] [ 1 zeller-congruence ] map-with
|
||||
] map concat [ zero? ] count ;
|
||||
|
||||
! [ euler019 ] 100 ave-time
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math math.functions math.ranges namespaces
|
||||
project-euler.common sequences ;
|
||||
project-euler.common sequences sequences.lib ;
|
||||
IN: project-euler.021
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=21
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math math.ranges ;
|
||||
USING: kernel math math.ranges sequences.lib ;
|
||||
IN: project-euler.028
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=28
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math math.functions project-euler.common sequences ;
|
||||
USING: kernel math math.functions project-euler.common sequences sequences.lib ;
|
||||
IN: project-euler.030
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=30
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math.ranges project-euler.common sequences ;
|
||||
USING: kernel math.ranges project-euler.common sequences sequences.lib ;
|
||||
IN: project-euler.034
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=34
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math math.combinatorics math.parser math.primes
|
||||
project-euler.common sequences ;
|
||||
USING: kernel math math.combinatorics math.parser math.primes
|
||||
project-euler.common sequences sequences.lib ;
|
||||
IN: project-euler.035
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=35
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math.parser math.ranges sequences ;
|
||||
USING: combinators.lib kernel math.parser math.ranges project-euler.common
|
||||
sequences ;
|
||||
IN: project-euler.036
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=36
|
||||
|
|
@ -24,12 +25,9 @@ IN: project-euler.036
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: palindrome? ( str -- ? )
|
||||
dup reverse = ;
|
||||
|
||||
: both-bases? ( n -- ? )
|
||||
{ [ dup number>string palindrome? ]
|
||||
[ dup >bin palindrome? ] } && nip ;
|
||||
{ [ dup palindrome? ]
|
||||
[ dup >bin dup reverse = ] } && nip ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays combinators.lib kernel math math.ranges namespaces
|
||||
project-euler.common sequences ;
|
||||
USING: arrays combinators.cleave combinators.lib kernel math math.ranges
|
||||
namespaces project-euler.common sequences ;
|
||||
IN: project-euler.039
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=39
|
||||
|
|
@ -43,7 +43,7 @@ SYMBOL: p-count
|
|||
: (count-perimeters) ( seq -- )
|
||||
dup sum max-p < [
|
||||
dup sum adjust-p-count
|
||||
[ u-transform ] keep [ a-transform ] keep d-transform
|
||||
[ u-transform ] [ a-transform ] [ d-transform ] tri
|
||||
[ (count-perimeters) ] 3apply
|
||||
] [
|
||||
drop
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: ascii combinators.lib io.files kernel math math.functions namespaces
|
||||
project-euler.common sequences splitting ;
|
||||
USING: ascii io.files kernel math math.functions namespaces
|
||||
project-euler.common sequences sequences.lib splitting ;
|
||||
IN: project-euler.042
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=42
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib hashtables kernel math math.combinatorics math.parser
|
||||
math.ranges project-euler.common sequences sorting ;
|
||||
math.ranges project-euler.common sequences sequences.lib sorting ;
|
||||
IN: project-euler.043
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=43
|
||||
|
|
|
|||
|
|
@ -30,9 +30,6 @@ IN: project-euler.044
|
|||
: nth-pentagonal ( n -- seq )
|
||||
dup 3 * 1- * 2 / ;
|
||||
|
||||
: pentagonal? ( n -- ? )
|
||||
dup 0 > [ 24 * 1+ sqrt 1+ 6 / 1 mod zero? ] [ drop f ] if ;
|
||||
|
||||
: sum-and-diff? ( m n -- ? )
|
||||
2dup + -rot - [ pentagonal? ] 2apply and ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,49 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math project-euler.common ;
|
||||
IN: project-euler.045
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=45
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! Triangle, pentagonal, and hexagonal numbers are generated by the following
|
||||
! formulae:
|
||||
! Triangle Tn = n(n + 1) / 2 1, 3, 6, 10, 15, ...
|
||||
! Pentagonal Pn = n(3n − 1) / 2 1, 5, 12, 22, 35, ...
|
||||
! Hexagonal Hn = n(2n − 1) 1, 6, 15, 28, 45, ...
|
||||
|
||||
! It can be verified that T285 = P165 = H143 = 40755.
|
||||
|
||||
! Find the next triangle number that is also pentagonal and hexagonal.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
! All hexagonal numbers are also triangle numbers, so iterate through hexagonal
|
||||
! numbers until you find one that is pentagonal as well.
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: nth-hexagonal ( n -- m )
|
||||
dup 2 * 1- * ;
|
||||
|
||||
DEFER: next-solution
|
||||
|
||||
: (next-solution) ( n hexagonal -- hexagonal )
|
||||
dup pentagonal? [ nip ] [ drop next-solution ] if ;
|
||||
|
||||
: next-solution ( n -- m )
|
||||
1+ dup nth-hexagonal (next-solution) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler045 ( -- answer )
|
||||
143 next-solution ;
|
||||
|
||||
! [ euler045 ] 100 ave-time
|
||||
! 18 ms run / 1 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler045
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.primes math.ranges sequences ;
|
||||
IN: project-euler.046
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=46
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! It was proposed by Christian Goldbach that every odd composite number can be
|
||||
! written as the sum of a prime and twice a square.
|
||||
|
||||
! 9 = 7 + 2 * 1^2
|
||||
! 15 = 7 + 2 * 2^2
|
||||
! 21 = 3 + 2 * 3^2
|
||||
! 25 = 7 + 2 * 3^2
|
||||
! 27 = 19 + 2 * 2^2
|
||||
! 33 = 31 + 2 * 1^2
|
||||
|
||||
! It turns out that the conjecture was false.
|
||||
|
||||
! What is the smallest odd composite that cannot be written as the sum of a
|
||||
! prime and twice a square?
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: perfect-squares ( n -- seq )
|
||||
2 /i sqrt >integer [1,b] [ sq ] map ;
|
||||
|
||||
: fits-conjecture? ( n -- ? )
|
||||
dup perfect-squares [ 2 * - ] with map [ prime? ] contains? ;
|
||||
|
||||
: next-odd-composite ( n -- m )
|
||||
dup odd? [ 2 + ] [ 1+ ] if dup prime? [ next-odd-composite ] when ;
|
||||
|
||||
: disprove-conjecture ( n -- m )
|
||||
dup fits-conjecture? [ next-odd-composite disprove-conjecture ] when ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler046 ( -- answer )
|
||||
9 disprove-conjecture ;
|
||||
|
||||
! [ euler046 ] 100 ave-time
|
||||
! 150 ms run / 2 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler046
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math math.functions ;
|
||||
USING: kernel math math.functions sequences.lib ;
|
||||
IN: project-euler.048
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=48
|
||||
|
|
|
|||
|
|
@ -0,0 +1,35 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.combinatorics math.ranges sequences.lib ;
|
||||
IN: project-euler.053
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=53
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! There are exactly ten ways of selecting three from five, 12345:
|
||||
|
||||
! 123, 124, 125, 134, 135, 145, 234, 235, 245, and 345
|
||||
|
||||
! In combinatorics, we use the notation, 5C3 = 10.
|
||||
|
||||
! In general,
|
||||
! nCr = n! / r! * (n - r)!
|
||||
! where r ≤ n, n! = n * (n − 1) * ... * 3 * 2 * 1, and 0! = 1.
|
||||
|
||||
! It is not until n = 23, that a value exceeds one-million: 23C10 = 1144066.
|
||||
|
||||
! How many values of nCr, for 1 ≤ n ≤ 100, are greater than one-million?
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
: euler053 ( -- answer )
|
||||
23 100 [a,b] [ dup [ nCk 1000000 > ] with count ] sigma ;
|
||||
|
||||
! [ euler053 ] 100 ave-time
|
||||
! 64 ms run / 2 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler053
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.parser project-euler.common sequences sequences.lib ;
|
||||
IN: project-euler.055
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=55
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! If we take 47, reverse and add, 47 + 74 = 121, which is palindromic.
|
||||
|
||||
! Not all numbers produce palindromes so quickly. For example,
|
||||
|
||||
! 349 + 943 = 1292,
|
||||
! 1292 + 2921 = 4213
|
||||
! 4213 + 3124 = 7337
|
||||
|
||||
! That is, 349 took three iterations to arrive at a palindrome.
|
||||
|
||||
! Although no one has proved it yet, it is thought that some numbers, like 196,
|
||||
! never produce a palindrome. A number that never forms a palindrome through
|
||||
! the reverse and add process is called a Lychrel number. Due to the
|
||||
! theoretical nature of these numbers, and for the purpose of this problem, we
|
||||
! shall assume that a number is Lychrel until proven otherwise. In addition you
|
||||
! are given that for every number below ten-thousand, it will either (i) become a
|
||||
! palindrome in less than fifty iterations, or, (ii) no one, with all the
|
||||
! computing power that exists, has managed so far to map it to a palindrome. In
|
||||
! fact, 10677 is the first number to be shown to require over fifty iterations
|
||||
! before producing a palindrome: 4668731596684224866951378664 (53 iterations,
|
||||
! 28-digits).
|
||||
|
||||
! Surprisingly, there are palindromic numbers that are themselves Lychrel
|
||||
! numbers; the first example is 4994.
|
||||
|
||||
! How many Lychrel numbers are there below ten-thousand?
|
||||
|
||||
! NOTE: Wording was modified slightly on 24 April 2007 to emphasise the
|
||||
! theoretical nature of Lychrel numbers.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: add-reverse ( n -- m )
|
||||
dup number>digits reverse 10 digits>integer + ;
|
||||
|
||||
: (lychrel?) ( n iteration -- ? )
|
||||
dup 50 < [
|
||||
>r add-reverse dup palindrome?
|
||||
[ r> 2drop f ] [ r> 1+ (lychrel?) ] if
|
||||
] [
|
||||
2drop t
|
||||
] if ;
|
||||
|
||||
: lychrel? ( n -- ? )
|
||||
1 (lychrel?) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler055 ( -- answer )
|
||||
10000 [ lychrel? ] count ;
|
||||
|
||||
! [ euler055 ] 100 ave-time
|
||||
! 1370 ms run / 31 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler055
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math.functions math.ranges project-euler.common sequences ;
|
||||
IN: project-euler.056
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=56
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! A googol (10^100) is a massive number: one followed by one-hundred zeros;
|
||||
! 100^100 is almost unimaginably large: one followed by two-hundred zeros.
|
||||
! Despite their size, the sum of the digits in each number is only 1.
|
||||
|
||||
! Considering natural numbers of the form, a^b, where a, b < 100, what is the
|
||||
! maximum digital sum?
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
! Through analysis, you only need to check when a and b > 90
|
||||
|
||||
: euler056 ( -- answer )
|
||||
90 100 [a,b) dup cartesian-product
|
||||
[ first2 ^ number>digits sum ] map supremum ;
|
||||
|
||||
! [ euler056 ] 100 ave-time
|
||||
! 33 ms run / 1 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler056
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays combinators.lib kernel math math.ranges namespaces
|
||||
project-euler.common sequences ;
|
||||
USING: arrays combinators.cleave combinators.lib kernel math math.ranges
|
||||
namespaces project-euler.common sequences sequences.lib ;
|
||||
IN: project-euler.075
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=75
|
||||
|
|
@ -56,7 +56,7 @@ SYMBOL: p-count
|
|||
: (count-perimeters) ( seq -- )
|
||||
dup sum max-p < [
|
||||
dup sum adjust-p-count
|
||||
[ u-transform ] keep [ a-transform ] keep d-transform
|
||||
[ u-transform ] [ a-transform ] [ d-transform ] tri
|
||||
[ (count-perimeters) ] 3apply
|
||||
] [
|
||||
drop
|
||||
|
|
|
|||
|
|
@ -0,0 +1,54 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.ranges sequences ;
|
||||
IN: project-euler.092
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=92
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! A number chain is created by continuously adding the square of the digits in
|
||||
! a number to form a new number until it has been seen before.
|
||||
|
||||
! For example,
|
||||
|
||||
! 44 -> 32 -> 13 -> 10 -> 1 -> 1
|
||||
! 85 -> 89 -> 145 -> 42 -> 20 -> 4 -> 16 -> 37 -> 58 -> 89
|
||||
|
||||
! Therefore any chain that arrives at 1 or 89 will become stuck in an endless
|
||||
! loop. What is most amazing is that EVERY starting number will eventually
|
||||
! arrive at 1 or 89.
|
||||
|
||||
! How many starting numbers below ten million will arrive at 89?
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: next-link ( n -- m )
|
||||
0 swap [ dup zero? not ] [ 10 /mod sq -rot [ + ] dip ] [ ] while drop ;
|
||||
|
||||
: chain-ending ( n -- m )
|
||||
dup 1 = over 89 = or [ next-link chain-ending ] unless ;
|
||||
|
||||
: lower-endings ( -- seq )
|
||||
567 [1,b] [ chain-ending ] map ;
|
||||
|
||||
: fast-chain-ending ( seq n -- m )
|
||||
dup 567 > [ next-link ] when 1- swap nth ;
|
||||
|
||||
: count ( seq quot -- n )
|
||||
0 -rot [ rot >r call [ r> 1+ ] [ r> ] if ] curry each ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler092 ( -- answer )
|
||||
lower-endings 9999999 [1,b] [ fast-chain-ending 89 = ] with count ;
|
||||
|
||||
! [ euler092 ] 10 ave-time
|
||||
! 11169 ms run / 0 ms GC ave time - 10 trials
|
||||
|
||||
MAIN: euler092
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
USING: arrays combinators.lib kernel math math.functions math.miller-rabin
|
||||
math.matrices math.parser math.primes.factors math.ranges namespaces
|
||||
sequences sorting unicode.case ;
|
||||
USING: arrays kernel math math.functions math.miller-rabin math.matrices
|
||||
math.parser math.primes.factors math.ranges namespaces sequences
|
||||
sequences.lib sorting unicode.case ;
|
||||
IN: project-euler.common
|
||||
|
||||
! A collection of words used by more than one Project Euler solution
|
||||
|
|
@ -9,13 +9,15 @@ IN: project-euler.common
|
|||
! Problems using each public word
|
||||
! -------------------------------
|
||||
! alpha-value - #22, #42
|
||||
! cartesian-product - #4, #27, #29, #32, #33
|
||||
! cartesian-product - #4, #27, #29, #32, #33, #43, #44, #56
|
||||
! collect-consecutive - #8, #11
|
||||
! log10 - #25, #134
|
||||
! max-path - #18, #67
|
||||
! nth-triangle - #12, #42
|
||||
! number>digits - #16, #20, #30, #34
|
||||
! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56
|
||||
! palindrome? - #4, #36, #55
|
||||
! pandigital? - #32, #38
|
||||
! pentagonal? - #44, #45
|
||||
! propagate-all - #18, #67
|
||||
! sum-proper-divisors - #21
|
||||
! tau* - #12
|
||||
|
|
@ -76,14 +78,20 @@ PRIVATE>
|
|||
] if ;
|
||||
|
||||
: number>digits ( n -- seq )
|
||||
number>string string>digits ;
|
||||
[ dup zero? not ] [ 10 /mod ] [ ] unfold reverse nip ;
|
||||
|
||||
: nth-triangle ( n -- n )
|
||||
dup 1+ * 2 / ;
|
||||
|
||||
: palindrome? ( n -- ? )
|
||||
number>string dup reverse = ;
|
||||
|
||||
: pandigital? ( n -- ? )
|
||||
number>string natural-sort "123456789" = ;
|
||||
|
||||
: pentagonal? ( n -- ? )
|
||||
dup 0 > [ 24 * 1+ sqrt 1+ 6 / 1 mod zero? ] [ drop f ] if ;
|
||||
|
||||
! Not strictly needed, but it is nice to be able to dump the triangle after the
|
||||
! propagation
|
||||
: propagate-all ( triangle -- newtriangle )
|
||||
|
|
|
|||
|
|
@ -13,9 +13,10 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
|
|||
project-euler.033 project-euler.034 project-euler.035 project-euler.036
|
||||
project-euler.037 project-euler.038 project-euler.039 project-euler.040
|
||||
project-euler.041 project-euler.042 project-euler.043 project-euler.044
|
||||
project-euler.048 project-euler.052 project-euler.067 project-euler.075
|
||||
project-euler.079 project-euler.097 project-euler.134 project-euler.169
|
||||
project-euler.173 project-euler.175 ;
|
||||
project-euler.045 project-euler.046 project-euler.048 project-euler.052
|
||||
project-euler.053 project-euler.056 project-euler.067 project-euler.075
|
||||
project-euler.079 project-euler.092 project-euler.097 project-euler.134
|
||||
project-euler.169 project-euler.173 project-euler.175 ;
|
||||
IN: project-euler
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -1,5 +1,18 @@
|
|||
USING: arrays kernel sequences sequences.lib math
|
||||
math.functions tools.test strings math.ranges ;
|
||||
USING: arrays kernel sequences sequences.lib math math.functions math.ranges
|
||||
tools.test strings ;
|
||||
IN: temporary
|
||||
|
||||
[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test
|
||||
[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test
|
||||
[ 328350 ] [ 100 [ sq ] sigma ] unit-test
|
||||
|
||||
[ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer
|
||||
{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test
|
||||
|
||||
[ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer
|
||||
{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test
|
||||
{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test
|
||||
[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
|
||||
|
||||
[ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test
|
||||
[ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test
|
||||
|
|
@ -7,6 +20,8 @@ math.functions tools.test strings math.ranges ;
|
|||
[ 10 ] [ { 1 2 3 4 } [ + ] reduce* ] unit-test
|
||||
[ 24 ] [ { 1 2 3 4 } [ * ] reduce* ] unit-test
|
||||
|
||||
[ 1 2 3 4 ] [ { 1 2 3 4 } 4 nfirst ] unit-test
|
||||
|
||||
[ -4 ] [ 1 -4 [ abs ] higher ] unit-test
|
||||
[ 1 ] [ 1 -4 [ abs ] lower ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel sequences math namespaces assocs
|
||||
random sequences.private shuffle math.functions mirrors
|
||||
arrays math.parser sorting strings ascii macros ;
|
||||
arrays math.parser math.private sorting strings ascii macros ;
|
||||
IN: sequences.lib
|
||||
|
||||
: each-withn ( seq quot n -- ) nwith each ; inline
|
||||
|
|
@ -190,7 +190,18 @@ PRIVATE>
|
|||
! List the positions of obj in seq
|
||||
|
||||
: indices ( seq obj -- seq )
|
||||
>r dup length swap r>
|
||||
[ = [ ] [ drop f ] if ] curry
|
||||
2map
|
||||
[ ] subset ;
|
||||
>r dup length swap r>
|
||||
[ = [ ] [ drop f ] if ] curry
|
||||
2map
|
||||
[ ] subset ;
|
||||
|
||||
<PRIVATE
|
||||
: (attempt-each-integer) ( i n quot -- result )
|
||||
[
|
||||
iterate-step roll
|
||||
[ 3nip ] [ iterate-next (attempt-each-integer) ] if*
|
||||
] [ 3drop f ] if-iterate? ; inline
|
||||
PRIVATE>
|
||||
|
||||
: attempt-each ( seq quot -- result )
|
||||
(each) iterate-prep (attempt-each-integer) ; inline
|
||||
|
|
|
|||
|
|
@ -25,6 +25,8 @@ MACRO: ntuck ( n -- ) 2 + [ dup , -nrot ] bake ;
|
|||
|
||||
: 3nip ( a b c d -- d ) 3 nnip ; inline
|
||||
|
||||
: 4nip ( a b c d e -- e ) 4 nnip ; inline
|
||||
|
||||
: 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline
|
||||
|
||||
: 4drop ( a b c d -- ) 3drop drop ; inline
|
||||
|
|
|
|||
|
|
@ -41,7 +41,6 @@ TUPLE: fica-base-unknown ;
|
|||
MIXIN: collector
|
||||
GENERIC: adjust-allowances ( salary w4 collector -- newsalary )
|
||||
GENERIC: withholding ( salary w4 collector -- x )
|
||||
GENERIC: net ( salary w4 collector -- x )
|
||||
|
||||
TUPLE: tax-table single married ;
|
||||
|
||||
|
|
@ -102,14 +101,6 @@ M: federal withholding ( salary w4 tax-table -- x )
|
|||
[ fica-tax ] 2keep
|
||||
medicare-tax + + ;
|
||||
|
||||
M: federal net ( salary w4 collector -- x )
|
||||
>r dupd r> withholding - ;
|
||||
|
||||
M: collector net ( salary w4 collector -- x )
|
||||
>r dupd r>
|
||||
[ withholding ] 3keep
|
||||
drop <federal> withholding + - ;
|
||||
|
||||
|
||||
! Minnesota
|
||||
: minnesota-single ( -- triples )
|
||||
|
|
@ -138,3 +129,10 @@ M: minnesota adjust-allowances ( salary w4 collector -- newsalary )
|
|||
|
||||
M: minnesota withholding ( salary w4 collector -- x )
|
||||
[ adjust-allowances ] 2keep marriage-table tax ;
|
||||
|
||||
: employer-withhold ( salary w4 collector -- x )
|
||||
[ withholding ] 3keep
|
||||
dup federal? [ 3drop ] [ drop <federal> withholding + ] if ;
|
||||
|
||||
: net ( salary w4 collector -- x )
|
||||
>r dupd r> employer-withhold - ;
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue