build-linux:
runs-on: ubuntu-latest
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- name: bootstrap
run: ./build.sh net-bootstrap
- name: load-all
build-macos:
runs-on: macos-11
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- name: build
run: arch -x86_64 ./build.sh net-bootstrap
- name: load-all
build-windows:
runs-on: windows-latest
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- uses: ilammy/msvc-dev-cmd@v1
- name: build
shell: cmd
build-linux:
runs-on: ubuntu-latest
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- name: bootstrap
run: ./build.sh net-bootstrap
- name: load-all
build-macos:
runs-on: macos-11
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- name: build
run: arch -x86_64 ./build.sh net-bootstrap
- name: load-all
build-windows:
runs-on: windows-latest
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v4
- uses: ilammy/msvc-dev-cmd@v1
- name: build
shell: cmd
+# build-<target> or build
+BUILD_DIR ?= build
+
ifdef CONFIG
VERSION = 0.100
GIT_LABEL = $(shell echo `git describe --all`-`git rev-parse HEAD`)
CFLAGS += -g -DFACTOR_DEBUG
else
CFLAGS += -O3
+ CFLAGS += $(CC_OPT)
endif
ifneq ($(REPRODUCIBLE), 0)
CONSOLE_EXECUTABLE = factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION)
DLL_OBJS = $(PLAF_DLL_OBJS) \
- vm/aging_collector.o \
- vm/alien.o \
- vm/arrays.o \
- vm/bignum.o \
- vm/byte_arrays.o \
- vm/callbacks.o \
- vm/callstack.o \
- vm/code_blocks.o \
- vm/code_heap.o \
- vm/compaction.o \
- vm/contexts.o \
- vm/data_heap.o \
- vm/data_heap_checker.o \
- vm/debug.o \
- vm/dispatch.o \
- vm/entry_points.o \
- vm/errors.o \
- vm/factor.o \
- vm/full_collector.o \
- vm/gc.o \
- vm/image.o \
- vm/inline_cache.o \
- vm/instruction_operands.o \
- vm/io.o \
- vm/jit.o \
- vm/math.o \
- vm/mvm.o \
- vm/nursery_collector.o \
- vm/object_start_map.o \
- vm/objects.o \
- vm/primitives.o \
- vm/quotations.o \
- vm/run.o \
- vm/safepoints.o \
- vm/sampling_profiler.o \
- vm/strings.o \
- vm/to_tenured_collector.o \
- vm/tuples.o \
- vm/utilities.o \
- vm/vm.o \
- vm/words.o
+ $(BUILD_DIR)/aging_collector.o \
+ $(BUILD_DIR)/alien.o \
+ $(BUILD_DIR)/arrays.o \
+ $(BUILD_DIR)/bignum.o \
+ $(BUILD_DIR)/byte_arrays.o \
+ $(BUILD_DIR)/callbacks.o \
+ $(BUILD_DIR)/callstack.o \
+ $(BUILD_DIR)/code_blocks.o \
+ $(BUILD_DIR)/code_heap.o \
+ $(BUILD_DIR)/compaction.o \
+ $(BUILD_DIR)/contexts.o \
+ $(BUILD_DIR)/data_heap.o \
+ $(BUILD_DIR)/data_heap_checker.o \
+ $(BUILD_DIR)/debug.o \
+ $(BUILD_DIR)/dispatch.o \
+ $(BUILD_DIR)/entry_points.o \
+ $(BUILD_DIR)/errors.o \
+ $(BUILD_DIR)/factor.o \
+ $(BUILD_DIR)/full_collector.o \
+ $(BUILD_DIR)/gc.o \
+ $(BUILD_DIR)/image.o \
+ $(BUILD_DIR)/inline_cache.o \
+ $(BUILD_DIR)/instruction_operands.o \
+ $(BUILD_DIR)/io.o \
+ $(BUILD_DIR)/jit.o \
+ $(BUILD_DIR)/math.o \
+ $(BUILD_DIR)/mvm.o \
+ $(BUILD_DIR)/nursery_collector.o \
+ $(BUILD_DIR)/object_start_map.o \
+ $(BUILD_DIR)/objects.o \
+ $(BUILD_DIR)/primitives.o \
+ $(BUILD_DIR)/quotations.o \
+ $(BUILD_DIR)/run.o \
+ $(BUILD_DIR)/safepoints.o \
+ $(BUILD_DIR)/sampling_profiler.o \
+ $(BUILD_DIR)/strings.o \
+ $(BUILD_DIR)/to_tenured_collector.o \
+ $(BUILD_DIR)/tuples.o \
+ $(BUILD_DIR)/utilities.o \
+ $(BUILD_DIR)/vm.o \
+ $(BUILD_DIR)/words.o
MASTER_HEADERS = $(PLAF_MASTER_HEADERS) \
vm/assert.hpp \
FFI_TEST_LIBRARY = libfactor-ffi-test$(SHARED_DLL_EXTENSION)
- TEST_OBJS = vm/ffi_test.o
+ TEST_OBJS = $(BUILD_DIR)/ffi_test.o
endif
+# if CONFIG is not set, call build.sh and find a CONFIG
+# build.sh will call GNUMakefile again to start the build
default:
$(MAKE) `./build.sh make-target`
@echo "DEBUG=1 compile VM with debugging information"
@echo "REPRODUCIBLE=1 compile VM without timestamp"
@echo "SITE_CFLAGS=... additional optimization flags"
+ @echo "LTO=1 compile VM with Link Time Optimization"
@echo "X11=1 force link with X11 libraries instead of Cocoa (only on Mac OS X)"
ALL = factor factor-ffi-test factor-lib
$(MAKE) $(ALL) CONFIG=vm/Config.windows.x86.64
$(MAKE) factor-console CONFIG=vm/Config.windows.x86.64
+# Actually build Factor
ifdef CONFIG
macosx.app: factor
factor-ffi-test: $(FFI_TEST_LIBRARY)
-$(FFI_TEST_LIBRARY): vm/ffi_test.o
+$(BUILD_DIR):
+ @echo BUILD_DIR: $(BUILD_DIR)
+ @mkdir -p $(BUILD_DIR)
+
+$(FFI_TEST_LIBRARY): $(BUILD_DIR)/ffi_test.o | $(BUILD_DIR)
$(TOOLCHAIN_PREFIX)$(CC) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o $(FFI_TEST_LIBRARY) $(TEST_OBJS)
-vm/resources.o:
- $(TOOLCHAIN_PREFIX)$(WINDRES) --preprocessor=cat vm/factor.rs vm/resources.o
+$(BUILD_DIR)/resources.o: vm/factor.rs | $(BUILD_DIR)
+ $(TOOLCHAIN_PREFIX)$(WINDRES) --preprocessor=cat $< $@
-vm/ffi_test.o: vm/ffi_test.c
+$(BUILD_DIR)/ffi_test.o: vm/ffi_test.c | $(BUILD_DIR)
$(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -std=c99 -o $@ $<
-vm/master.hpp.gch: vm/master.hpp $(MASTER_HEADERS)
+$(BUILD_DIR)/master.hpp.gch: vm/master.hpp $(MASTER_HEADERS) | $(BUILD_DIR)
$(TOOLCHAIN_PREFIX)$(CXX) -c -x c++-header $(CFLAGS) $(CXXFLAGS) -o $@ $<
-%.o: %.cpp vm/master.hpp.gch
+$(BUILD_DIR)/%.o: vm/%.cpp $(BUILD_DIR)/master.hpp.gch | $(BUILD_DIR)
$(TOOLCHAIN_PREFIX)$(CXX) -c $(CFLAGS) $(CXXFLAGS) -o $@ $<
-%.o: %.S
+$(BUILD_DIR)/%.o: $(BUILD_DIR)/%.S | $(BUILD_DIR)
$(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) $(CXXFLAGS) -o $@ $<
-%.o: %.mm vm/master.hpp.gch
+$(BUILD_DIR)/%.o: vm/%.mm $(BUILD_DIR)/master.hpp.gch | $(BUILD_DIR)
$(TOOLCHAIN_PREFIX)$(CXX) -c $(CFLAGS) $(CXXFLAGS) -o $@ $<
.SUFFIXES: .mm
endif
clean:
- rm -f vm/*.gch
+ @echo make clean CONFIG: \`$(CONFIG)\`
+ @echo make clean BUILD_DIR: \`$(BUILD_DIR)\`
+ if [ -n "$(BUILD_DIR)" ] && [ "$(BUILD_DIR)" != "/" ]; then rm -f $(BUILD_DIR)/*.o; rm -f $(BUILD_DIR)/*.gch; fi
+ rm -f build/*.o
+ rm -f build/*.gch
rm -f vm/*.o
+ rm -f vm/*.gch
+ rm -f factor
rm -f factor.dll
rm -f factor.lib
rm -f factor.dll.lib
big-endian off
+: context-callstack-top-offset ( -- n ) 0 bootstrap-cells ; inline
+: context-callstack-bottom-offset ( -- n ) 2 bootstrap-cells ; inline
+: context-datastack-offset ( -- n ) 3 bootstrap-cells ; inline
+: context-retainstack-offset ( -- n ) 4 bootstrap-cells ; inline
+: context-callstack-save-offset ( -- n ) 5 bootstrap-cells ; inline
+: context-callstack-seg-offset ( -- n ) 8 bootstrap-cells ; inline
+
! X0-X17 volatile scratch registers
! X0-X8 parameter registers
! X0 result register
: store1 ( -- ) 0 ds-reg temp1 STRuoff ;
: store0/1 ( -- ) -8 ds-reg temp1 temp0 STPsoff ;
: store0/2 ( -- ) -8 ds-reg temp2 temp0 STPsoff ;
+: store2/0 ( -- ) -8 ds-reg temp0 temp2 STPsoff ;
: store1/0 ( -- ) -8 ds-reg temp0 temp1 STPsoff ;
: store1/2 ( -- ) -16 ds-reg temp2 temp1 STPsoff ;
+! add tag bits to integers
:: tag ( reg -- ) tag-bits get reg reg LSLi ;
+! remove tag bits
:: untag ( reg -- ) tag-bits get reg reg ASRi ;
+
: tagged>offset0 ( -- ) 1 temp0 temp0 ASRi ;
+! pops an item from the data stack and pushes it
+! onto the retain stack (used for dip-like operations)
: >r ( -- ) pop0 pushr ;
+
+! pops an item from the retain stack and pushes it
+! onto the data stack (used for dip-like operations)
: r> ( -- ) popr push0 ;
: absolute-jump ( -- word class )
3 words Br
NOP NOP f rc-absolute-cell ; inline
+! This is used when a word is called at the end of a quotation.
+! JIT-WORD-CALL is used for other word calls.
[
- ! ! pic-tail-reg 5 [RIP+] LEA
! why do we store the address after JMP in EBX, where is it
! picked up?
4 pic-tail-reg ADR
- ! ! 0 JMP f rc-relative rel-word-pic-tail
- ! 0 Br f rc-relative-arm64-branch rel-word-pic-tail
absolute-jump rel-word-pic-tail
] JIT-WORD-JUMP jit-define
+! This is used when a word is called.
+! JIT-WORD-JUMP is used if the word is the last piece of code in a quotation.
[
- ! ! 0 CALL f rc-relative rel-word-pic
- ! push-link-reg
- ! 0 BL f rc-relative-arm64-branch rel-word-pic
- ! pop-link-reg
absolute-call rel-word-pic
] JIT-WORD-CALL jit-define
: jit-call ( name -- )
- ! RAX 0 MOV f rc-absolute-cell rel-dlsym
- ! RAX CALL ;
absolute-call rel-dlsym ;
:: jit-call-1arg ( arg1s name -- )
- ! arg1 arg1s MOVr
- ! name jit-call ;
arg1s arg1 MOVr
name jit-call ;
arg2s arg2 MOVr
name jit-call ;
+! loads the address of the vm struct.
+! A no-op on ARM (vm-reg always contains this address).
: jit-load-vm ( -- ) ;
+! Loads the address of the ctx struct into ctx-reg.
: jit-load-context ( -- )
- ! ctx-reg vm-reg vm-context-offset [+] MOV ;
vm-context-offset vm-reg ctx-reg LDRuoff ;
+! Saves the addresses of the callstack, datastack, and retainstack tops
+! into the corresponding fields in the ctx struct.
: jit-save-context ( -- )
jit-load-context
! The reason for -8 I think is because we are anticipating a CALL
! instruction. After the call instruction, the contexts frame_top
! will point to the origin jump address.
- ! R11 RSP -8 [+] LEA
- ! ctx-reg context-callstack-top-offset [+] R11 MOV
stack-reg temp0 MOVsp
16 temp0 temp0 SUBi
context-callstack-top-offset ctx-reg temp0 STRuoff
- ! ctx-reg context-datastack-offset [+] ds-reg MOV
- ! ctx-reg context-retainstack-offset [+] rs-reg MOV ;
context-datastack-offset ctx-reg ds-reg STRuoff
context-retainstack-offset ctx-reg rs-reg STRuoff ;
-! ctx-reg must already have been loaded
+! Retrieves the addresses of the datastack and retainstack tops
+! from the corresponding fields in the ctx struct.
+! ctx-reg must already have been loaded.
: jit-restore-context ( -- )
- ! ds-reg ctx-reg context-datastack-offset [+] MOV
- ! rs-reg ctx-reg context-retainstack-offset [+] MOV ;
context-datastack-offset ctx-reg ds-reg LDRuoff
context-retainstack-offset ctx-reg rs-reg LDRuoff ;
jit-restore-context
] JIT-PRIMITIVE jit-define
+! Used to a call a quotation if the quotation is the last piece of code
: jit-jump-quot ( -- )
- ! arg1 quot-entry-point-offset [+] JMP ;
quot-entry-point-offset arg1 temp0 LDUR
temp0 BR ;
+! Used to call a quotation if the quotation is not the last piece of code
: jit-call-quot ( -- )
- ! arg1 quot-entry-point-offset [+] CALL ;
push-link-reg
quot-entry-point-offset arg1 temp0 LDUR
temp0 BLR
pop-link-reg ;
+! calls a quotation
+[
+ pop-arg1
+]
+[ jit-call-quot ]
+[ jit-jump-quot ]
+\ (call) define-combinator-primitive
+
+[
+ jit-save-context
+ vm-reg arg2 MOVr
+ "lazy_jit_compile" jit-call
+]
+[ jit-call-quot ]
+[ jit-jump-quot ]
+\ lazy-jit-compile define-combinator-primitive
+
[
! temp2 0 MOV f rc-absolute-cell rel-literal
! temp1 temp2 CMP
NOP NOP f rc-absolute-cell rel-literal
] PIC-CHECK-TUPLE jit-define
+
! Inline cache miss entry points
: jit-load-return-address ( -- )
! RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
ctx-reg jit-update-tib ;
: jit-pop-context-and-param ( -- )
- ! arg1 ds-reg [] MOV
- ! arg1 arg1 alien-offset [+] MOV
- ! arg2 ds-reg -8 [+] MOV
- ! ds-reg 16 SUB ;
pop-arg1
alien-offset arg1 arg1 ADDi
0 arg1 arg1 LDRuoff
pop-arg2 ;
: jit-push-param ( -- )
- ! ds-reg 8 ADD
- ! ds-reg [] arg2 MOV ;
push-arg2 ;
: jit-set-context ( -- )
jit-pop-context-and-param
jit-save-context
arg1 jit-switch-context
- ! RSP 8 ADD
16 stack-reg stack-reg ADDi
jit-push-param ;
: jit-pop-quot-and-param ( -- )
- ! arg1 ds-reg [] MOV
- ! arg2 ds-reg -8 [+] MOV
- ! ds-reg 16 SUB ;
pop-arg1 pop-arg2 ;
: jit-start-context ( -- )
jit-jump-quot ;
[
- ! 0 [RIP+] EAX MOV rc-relative rel-safepoint
3 words temp0 LDRl
0 temp0 W0 STRuoff
3 words Br
NOP NOP rc-absolute-cell rel-safepoint
] JIT-SAFEPOINT jit-define
-! C to Factor entry point
+! The main C to Factor entry point.
+! Sets up and executes the boot quote,
+! then performs a teardown and returns into C++.
[
- 0xabcd BRK
! ! Optimizing compiler's side of callback accesses
! ! arguments that are on the stack via the frame pointer.
! ! On x86-32 fastcall, and x86-64, some arguments are passed
! frame-reg PUSH
! frame-reg stack-reg MOV
- ! ! Save all non-volatile registers
- ! nv-regs [ PUSH ] each
+ ! Save all non-volatile registers
-16 SP X19 X18 STPpre
-16 SP X21 X20 STPpre
-16 SP X23 X22 STPpre
jit-save-tib
- ! ! Load VM into vm-reg
- ! vm-reg 0 MOV 0 rc-absolute-cell rel-vm
+ ! Load VM into vm-reg
2 words vm-reg LDRl
3 words Br
NOP NOP 0 rc-absolute-cell rel-vm
- ! ! Save old context
- ! nv-reg vm-reg vm-context-offset [+] MOV
- ! nv-reg PUSH
+ ! Save old context
vm-context-offset vm-reg ctx-reg LDRuoff
8 SP ctx-reg STRuoff
- ! ! Switch over to the spare context
- ! nv-reg vm-reg vm-spare-context-offset [+] MOV
- ! vm-reg vm-context-offset [+] nv-reg MOV
+ ! Switch over to the spare context
vm-spare-context-offset vm-reg ctx-reg LDRuoff
vm-context-offset vm-reg ctx-reg STRuoff
- ! ! Save C callstack pointer
- ! nv-reg context-callstack-save-offset [+] stack-reg MOV
-
+ ! Save C callstack pointer
stack-reg temp0 MOVsp
context-callstack-save-offset ctx-reg temp0 STRuoff
- ! stack-reg X24 MOVsp
- ! NOP
- ! ! Load Factor stack pointers
- ! stack-reg nv-reg context-callstack-bottom-offset [+] MOV
+ ! Load Factor stack pointers
context-callstack-bottom-offset ctx-reg temp0 LDRuoff
temp0 stack-reg MOVsp
ctx-reg jit-update-tib
jit-install-seh
- ! rs-reg nv-reg context-retainstack-offset [+] MOV
- ! ds-reg nv-reg context-datastack-offset [+] MOV
context-retainstack-offset ctx-reg rs-reg LDRuoff
context-datastack-offset ctx-reg ds-reg LDRuoff
- ! ! Call into Factor code
- ! link-reg 0 MOV f rc-absolute-cell rel-word
- ! link-reg CALL
+ ! Call into Factor code
3 words temp0 LDRl
temp0 BLR
3 words Br
NOP NOP f rc-absolute-cell rel-word
- ! ! Load C callstack pointer
- ! nv-reg vm-reg vm-context-offset [+] MOV
- ! stack-reg nv-reg context-callstack-save-offset [+] MOV
+ ! Load C callstack pointer
vm-context-offset vm-reg ctx-reg LDRuoff
context-callstack-save-offset ctx-reg temp0 LDRuoff
temp0 stack-reg MOVsp
- ! X24 stack-reg MOVsp
- ! NOP
- ! ! Load old context
- ! nv-reg POP
- ! vm-reg vm-context-offset [+] nv-reg MOV
+ ! Load old context
8 SP ctx-reg LDRuoff
vm-context-offset vm-reg ctx-reg STRuoff
jit-restore-tib
- ! ! Restore non-volatile registers
- ! nv-regs <reversed> [ POP ] each
- ! frame-reg POP
+ ! Restore non-volatile registers
16 SP X30 LDRpost
16 SP X29 X28 LDPpost
16 SP X27 X26 LDPpost
16 SP X21 X20 LDPpost
16 SP X19 X18 LDPpost
- ! ! Callbacks which return structs, or use stdcall/fastcall/thiscall,
- ! ! need a parameter here.
+ ! Callbacks which return structs, or use stdcall/fastcall/thiscall,
+ ! need a parameter here.
- ! ! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
- ! 0xffff RET f rc-absolute-2 rel-untagged
- 4 words temp0 ADR
- 2 temp0 temp0 LDRHuoff
- temp0 stack-reg stack-reg ADDr
f RET
- NOP f rc-absolute-2 rel-untagged
] CALLBACK-STUB jit-define
+! pushes a literal value to the stack
[
- ! ! load literal
- ! temp0 0 MOV f rc-absolute-cell rel-literal
+ ! load literal
2 words temp0 LDRl
3 words Br
NOP NOP f rc-absolute-cell rel-literal
- ! ! increment datastack pointer
- ! ds-reg bootstrap-cell ADD
- ! ! store literal on datastack
- ! ds-reg [] temp0 MOV
+ ! store literal on datastack
push0
] JIT-PUSH-LITERAL jit-define
16 SP X3 X2 LDPpost
16 SP X1 X0 LDPpost ;
+! if-statement control flow
[
- ! ! load boolean
- ! temp0 ds-reg [] MOV
- ! ! pop boolean
- ! ds-reg bootstrap-cell SUB
+ ! pop boolean
pop0
- ! ! compare boolean with f
- ! temp0 \ f type-number CMP
+ ! compare boolean with f
\ f type-number temp0 CMPi
- ! ! jump to true branch if not equal
- ! ! 0 JNE f rc-relative rel-word
- ! 0 NE B.cond f rc-relative-arm64-bcond rel-word
+ ! skip over true branch if equal
5 words EQ B.cond
+ ! jump to true branch
absolute-jump rel-word
- ! ! jump to false branch if equal
- ! ! 0 JMP f rc-relative rel-word
- ! 0 Br f rc-relative-arm64-branch rel-word
+ ! jump to false branch
absolute-jump rel-word
] JIT-IF jit-define
+! calls the second item on the stack
[
>r
- ! ! 0 CALL f rc-relative rel-word
- ! push-link-reg
- ! 0 Br f rc-relative-arm64-branch rel-word
- ! pop-link-reg
absolute-call rel-word
r>
] JIT-DIP jit-define
+! calls the third item on the stack
[
>r >r
- ! ! 0 CALL f rc-relative rel-word
- ! push-link-reg
- ! 0 Br f rc-relative-arm64-branch rel-word
- ! pop-link-reg
absolute-call rel-word
r> r>
] JIT-2DIP jit-define
+! calls the fourth item on the stack
[
>r >r >r
- ! ! 0 CALL f rc-relative rel-word
- ! push-link-reg
- ! 0 Br f rc-relative-arm64-branch rel-word
- ! pop-link-reg
absolute-call rel-word
r> r> r>
] JIT-3DIP jit-define
+! executes a word pushed onto the stack with \
[
! ! load from stack
! temp0 ds-reg [] MOV
] JIT-EXECUTE jit-define
! https://elixir.bootlin.com/linux/latest/source/arch/arm64/kernel/stacktrace.c#L22
+! Performs setup for a quotation
[
! ! make room for LR plus magic number of callback, 16byte align
- ! x64 ! stack-reg stack-frame-size bootstrap-cell - SUB
stack-frame-size stack-reg stack-reg SUBi
push-link-reg
] JIT-PROLOG jit-define
+! Performs teardown for a quotation
[
- ! x64 ! stack-reg stack-frame-size bootstrap-cell - ADD
pop-link-reg
stack-frame-size stack-reg stack-reg ADDi
] JIT-EPILOG jit-define
+! returns to the outer stack frame
[ f RET ] JIT-RETURN jit-define
! ! ! Polymorphic inline caches
NOP f rc-absolute-1 rel-untagged
] PIC-LOAD jit-define
+! ! Factor 2024 Clinic Code:
+! ! this arm relocation could actually work
+! ! due to the small bitwidth required
+! 0 0 temp2 MOVZ f rc-absolute-arm64-movz rel-untagged
+! temp2 temp2 UXTB
+! temp2 ds-reg temp1 LDRr
+
[
! temp1/32 tag-mask get AND
tag-mask get temp1 temp1 ANDi
NOP f rc-absolute-1 rel-untagged
] PIC-CHECK-TAG jit-define
+! ! Factor 2024 Clinic Code:
+! ! this arm relocation could actually work
+! ! due to the small bitwidth required
+! 0 0 temp2 MOVZ f rc-absolute-arm64-movz rel-untagged
+! temp2 temp2 UXTB
+! temp2 temp1 CMPr
+
+
[
! ! 0 JE f rc-relative rel-word
! 0 EQ B.cond f rc-relative-arm64-bcond rel-word
] jit-conditional
] MEGA-LOOKUP jit-define
-! Comparisons
+! helper for comparison operations which return a boolean value
: jit-compare ( cond -- )
- ! ! load t
- ! temp3 0 MOV t rc-absolute-cell rel-literal
+ ! load t
2 words temp3 LDRl
3 words Br
NOP NOP t rc-absolute-cell rel-literal
- ! ! load f
- ! temp1 \ f type-number MOV
+ ! load f
\ f type-number temp2 MOVwi
- ! ! load first value
- ! temp0 ds-reg [] MOV
- ! ! adjust stack pointer
- ! ds-reg bootstrap-cell SUB
+ ! load values
load1/0
- ! ! compare with second value
- ! ds-reg [] temp0 CMP
+ ! compare
temp1 temp0 CMPr
- ! ! move t if true
- ! [ temp1 temp3 ] dip execute( dst src -- )
+ ! move t if true (f otherwise)
[ temp2 temp3 temp0 ] dip CSEL
- ! ! store
- ! ds-reg [] temp1 MOV
+ ! store
1 push-down0 ;
! Math
-! Overflowing fixnum arithmetic
+! Overflowing fixnum (integer) arithmetic
: jit-overflow ( insn func -- )
- ! ds-reg 8 SUB
jit-save-context
- ! arg1 ds-reg [] MOV
- ! arg2 ds-reg 8 [+] MOV
load-arg1/2
- ! arg3 arg1 MOV
- ! [ [ arg3 arg2 ] dip call ] dip
[ [ arg2 arg1 arg3 ] dip call ] dip
- ! ds-reg [] arg3 MOV
push-down-arg3
- ! [ JNO ]
- [ VC B.cond ] [
- ! arg3 vm-reg MOV
+ [ 8 fixnum+fast VC B.cond ] [
vm-reg arg3 MOVr
jit-call
] jit-conditional ; inline
+! non-overflowing fixnum (integer) arithmetic
: jit-math ( insn -- )
- ! ! load second input
- ! temp0 ds-reg [] MOV
- ! ! pop stack
- ! ds-reg bootstrap-cell SUB
+ ! load inputs
load1/0
- ! ! compute result
- ! [ ds-reg [] temp0 ] dip execute( dst src -- )
+ ! compute result
[ temp0 temp1 temp0 ] dip execute( arg2 arg1 dst -- )
+ ! store result
1 push-down0 ;
+! fixnum (integer) division and modulo operations.
+! Does not tag or push results.
: jit-fixnum-/mod ( -- )
- ! ! load second parameter
- ! temp1 ds-reg [] MOV
- ! ! load first parameter
- ! div-arg ds-reg bootstrap-cell neg [+] MOV
+ ! load parameters
load1/0
- ! ! divide
+ ! divide
temp0 temp1 temp2 SDIV
temp1 temp0 temp2 temp0 MSUB ;
{ (start-context-and-delete) [ jit-start-context-and-delete ] }
! ## Entry points
+ ! called by callback-stub.
+ ! this contains some C++ setup/teardown,
+ ! as well as the actual call into the boot quote.
{ c-to-factor [
arg1 arg2 MOVr
vm-reg "begin_callback" jit-call-1arg
] }
! ## Math
- { fixnum+ [ [ ADDr ] "overflow_fixnum_add" jit-overflow ] }
- { fixnum- [ [ SUBr ] "overflow_fixnum_subtract" jit-overflow ] }
+ ! Overflowing fixnum (integer) addition
+ { fixnum+ [
+ [ ADDr ] "overflow_fixnum_add" jit-overflow ] }
+ ! Overflowing fixnum (integer) subtraction
+ { fixnum- [
+ [ SUBr ] "overflow_fixnum_subtract" jit-overflow ] }
+ ! Overflowing fixnum (integer) multiplication
{ fixnum* [
- ! ds-reg 8 SUB
- jit-save-context
- ! RCX ds-reg [] MOV
- ! RBX ds-reg 8 [+] MOV
- load1/0
- ! RBX tag-bits get SAR
- temp0 untag
- ! RAX RCX MOV
- ! RBX IMUL
- ! RAX * RBX = RDX:RAX
- temp1 temp0 temp0 MUL
- ! ds-reg [] RAX MOV
- 1 push-down0
- ! [ JNO ]
- [ VC B.cond ] [
- ! arg1 RCX MOV
- temp1 arg1 MOVr
- ! arg1 tag-bits get SAR
- temp1 untag
- ! arg2 RBX MOV
- temp0 arg2 MOVr
- ! arg3 vm-reg MOV
- vm-reg arg3 MOVr
- "overflow_fixnum_multiply" jit-call
- ] jit-conditional
- ] }
+ [ MUL ] "overflow_fixnum_multiply" jit-overflow ] }
! ## Misc
{ fpu-state [
FPSR XZR MSRr
FPCR arg1 MRS
] }
+
+! ! Factor 2024 Clinic Code:
+! FPCR arg1 MRS
+! FPSR XZR MSRr
+
{ set-fpu-state [
! RSP 2 SUB
! RSP [] arg1 16-bit-version-of MOV
f RET
] }
- ! ## Fixnums
+ ! ! Factor 2024 Clinic Code:
+ ! ! we think the below two lines
+ ! ! 2 temp0 temp0 SUBi ! callstack-length-offset
+ ! ! 0 temp0 arg3 LDRuoff
+ ! ! may need to be replaced with:
+ ! callstack-length-offset arg4 arg3 LDRuoff
+
- ! ### Add
+ ! ## Fixnums
+ ! Non-overflowing fixnum (integer) addition
{ fixnum+fast [ \ ADDr jit-math ] }
! ### Bit manipulation
+ ! fixnum (integer) bitwise AND
{ fixnum-bitand [ \ ANDr jit-math ] }
+
+ ! fixnum (integer) bitwise NOT
{ fixnum-bitnot [
- ! ! complement
- ! ds-reg [] NOT
load0
+ ! complement
temp0 temp0 MVN
- ! ! clear tag bits
- ! ds-reg [] tag-mask get XOR
+ ! clear tag bits
tag-mask get temp0 temp0 EORi
store0
] }
+
+ ! fixnum (integer) bitwise OR
{ fixnum-bitor [ \ ORRr jit-math ] }
+
+ ! fixnum (integer) bitwise XOR
{ fixnum-bitxor [ \ EORr jit-math ] }
+
+ ! fixnum (integer) bitwise shift (positive = left, negative = right)
{ fixnum-shift-fast [
- ! ! load shift count
- ! shift-arg ds-reg [] MOV
- ! ! adjust stack pointer
- ! ds-reg bootstrap-cell SUB
- ! ! load value
- ! temp3 ds-reg [] MOV
+ ! load shift count and value
load1/0
- ! ! untag shift count
- ! shift-arg tag-bits get SAR
+ ! untag shift count
temp0 untag
- ! ! make a copy
- ! temp2 temp3 MOV
+ ! make a copy
temp1 temp2 MOVr
- ! ! compute positive shift value in temp2
- ! temp2 CL SHL
+ ! compute positive shift value in temp1
temp0 temp1 temp1 LSLr
- ! ! compute negative shift value in temp3
- ! shift-arg NEG
+ ! compute negative shift value in temp2
temp0 temp0 NEG
- ! temp3 CL SAR
temp0 temp2 temp2 ASRr
- ! temp3 tag-mask get bitnot AND
tag-mask get bitnot temp2 temp2 ANDi
- ! ! if shift count was negative, move temp3 to temp2
- ! shift-arg 0 CMP
- ! temp2 temp3 CMOVGE
- temp2 temp1 temp0 PL CSEL
- ! ! push to stack
- ! ds-reg [] temp2 MOV
+ ! if shift count was negative
+ ! choose temp2 (else temp1)
+ 0 temp0 CMPi
+ temp2 temp1 temp0 MI CSEL
+ ! push to stack
1 push-down0
] }
! ### Comparisons
+ ! returns true if both arguments are fixnums, and false otherwise
{ both-fixnums? [
- ! temp0 ds-reg [] MOV
- ! ds-reg bootstrap-cell SUB
load1/0
- ! temp0 ds-reg [] OR
temp1 temp0 temp0 ORRr
- ! temp0 tag-mask get TEST
tag-mask get temp0 TSTi
- ! temp0 \ f type-number MOV
\ f type-number temp0 MOVwi
- ! temp1 1 tag-fixnum MOV
1 tag-fixnum temp1 MOVwi
- ! temp0 temp1 CMOVE
temp0 temp1 temp0 EQ CSEL
- ! ds-reg [] temp0 MOV
1 push-down0
] }
+
+ ! fixnum (integer) equality comparison
{ eq? [ EQ jit-compare ] }
+ ! fixnum (integer) greater-than comparison
{ fixnum> [ GT jit-compare ] }
+ ! fixnum (integer) greater-than-or-equal comparison
{ fixnum>= [ GE jit-compare ] }
+ ! fixnum (integer) less-than comparison
{ fixnum< [ LT jit-compare ] }
+ ! fixnum (integer) less-than-or-equal comparison
{ fixnum<= [ LE jit-compare ] }
! ### Div/mod
+ ! fixnum (integer) modulo
{ fixnum-mod [
jit-fixnum-/mod
- ! ! adjust stack pointer
- ! ds-reg bootstrap-cell SUB
- ! ! push to stack
- ! ds-reg [] mod-arg MOV
+ ! push to stack
1 push-down0
] }
+ ! fixnum (integer) division
{ fixnum/i-fast [
jit-fixnum-/mod
- ! ! adjust stack pointer
- ! ds-reg bootstrap-cell SUB
- ! ! tag it
- ! div-arg tag-bits get SHL
+ ! tag it
tag-bits get temp2 temp0 LSLi
- ! ! push to stack
- ! ds-reg [] div-arg MOV
+ ! push to stack
1 push-down0
] }
+ ! fixnum (integer) division and modulo
{ fixnum/mod-fast [
jit-fixnum-/mod
- ! ! tag it
- ! div-arg tag-bits get SHL
+ ! tag it
temp2 tag
- ! ! push to stack
- ! ds-reg [] mod-arg MOV
- ! ds-reg bootstrap-cell neg [+] div-arg MOV
- store0/2
+ ! push to stack
+ store2/0
] }
! ### Mul
+ ! Non-overflowing fixnum (integer) multiplication
{ fixnum*fast [
- ! ! load second input
- ! temp0 ds-reg [] MOV
- ! ! pop stack
- ! ds-reg bootstrap-cell SUB
- ! ! load first input
- ! temp1 ds-reg [] MOV
+ ! load both inputs
load1/0
- ! ! untag second input
- ! temp0 tag-bits get SAR
+ ! untag second input
temp0 untag
- ! ! multiply
- ! temp0 temp1 IMUL2
+ ! multiply
temp1 temp0 temp0 MUL
- ! ! push result
- ! ds-reg [] temp0 MOV
+ ! push result
1 push-down0
] }
! ### Sub
+ ! Non-overflowing fixnum (integer) subtraction
{ fixnum-fast [ \ SUBr jit-math ] }
! ## Locals
+ ! Drops all current locals stored on the retainstack.
{ drop-locals [
- ! ! load local count
- ! temp0 ds-reg [] MOV
- ! ! adjust stack pointer
- ! ds-reg bootstrap-cell SUB
+ ! load local count
pop0
- ! ! turn local number into offset
+ ! turn local number into offset
tagged>offset0
- ! ! decrement retain stack pointer
- ! rs-reg temp0 SUB
+ ! decrement retain stack pointer
temp0 rs-reg rs-reg SUBr
] }
+
+ ! Gets the nth local stored on the retainstack.
{ get-local [
- ! ! load local number
- ! temp0 ds-reg [] MOV
+ ! load local number
load0
- ! ! turn local number into offset
+ ! turn local number into offset
tagged>offset0
- ! ! load local value
- ! temp0 rs-reg temp0 [+] MOV
+ ! load local value
temp0 rs-reg temp0 LDRr
- ! ! push to stack
- ! ds-reg [] temp0 MOV
+ ! push to stack
store0
] }
+
+ ! Turns the top item on the datastack
+ ! into a local stored on the retainstack.
{ load-local [ >r ] }
! ## Objects
+ ! Reads the nth slot of a given object. (non-bounds-checking)
{ slot [
- ! ! load slot number
- ! temp0 ds-reg [] MOV
- ! ! adjust stack pointer
- ! ds-reg bootstrap-cell SUB
- ! ! load object
- ! temp1 ds-reg [] MOV
+ ! load object and slot number
load1/0
- ! ! turn slot number into offset
+ ! turn slot number into offset
tagged>offset0
- ! ! mask off tag
- ! temp1 tag-bits get SHR
- ! temp1 tag-bits get SHL
+ ! mask off tag
tag-mask get bitnot temp1 temp1 ANDi
- ! ! load slot value
- ! temp0 temp1 temp0 [+] MOV
+ ! load slot value
temp1 temp0 temp0 LDRr
- ! ! push to stack
- ! ds-reg [] temp0 MOV
+ ! push to stack
1 push-down0
] }
+
+ ! nth string element selector (non-bounds-checking)
{ string-nth-fast [
- ! ! load string index from stack
- ! temp0 ds-reg bootstrap-cell neg [+] MOV
- ! temp0 tag-bits get SHR
- ! ! load string from stack
- ! temp1 ds-reg [] MOV
+ ! load string index and string from stack
load1/0
- ! ! load character
- ! temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV
- ! temp0 temp0 8-bit-version-of MOVZX
- ! temp0 tag-bits get SHL
+ temp1 untag
+ ! load character
+ string-offset temp0 temp0 ADDi
temp1 temp0 temp0 LDRBr
temp0 tag
- ! ! store character to stack
- ! ds-reg bootstrap-cell SUB
- ! ds-reg [] temp0 MOV
+ ! store character to stack
1 push-down0
] }
+
+ ! add tag bits to integers
+ ! (the local word tag just shifts left)
{ tag [
- ! ! load from stack
- ! temp0 ds-reg [] MOV
+ ! load from stack
load0
- ! ! compute tag
- ! temp0/32 tag-mask get AND
+ ! compute tag
tag-mask get temp0 temp0 ANDi
- ! ! tag the tag
- ! temp0/32 tag-bits get SHL
+ ! tag the tag
temp0 tag
- ! ! push to stack
- ! ds-reg [] temp0 MOV
+ ! push to stack
store0
] }
- ! ! ## Shufflers
+ ! ## Shufflers
- ! ! ### Drops
+ ! ### Drops
+ ! drops the top n stack items
{ drop [ 1 ndrop ] }
{ 2drop [ 2 ndrop ] }
{ 3drop [ 3 ndrop ] }
{ 4drop [ 4 ndrop ] }
- ! ! ### Dups
+ ! ### Dups
+ ! duplicates the top n stack items in order
{ dup [ load0 push0 ] }
{ 2dup [ load1/0 push1 push0 ] }
{ 3dup [ load2 load1/0 push2 push1 push0 ] }
{ 4dup [ load3/2 load1/0 push3 push2 push1 push0 ] }
+ ! duplicates the second stack item and puts it below the top stack item
{ dupd [ load1/0 store1 push0 ] }
- ! ! ### Misc shufflers
+ ! ### Misc shufflers
+ ! Duplicates the second stack item and puts it above the top stack item
{ over [ load1 push1 ] }
+ ! Duplicates the the third stack item and puts it above the top stack item
{ pick [ load2 push2 ] }
- ! ! ### Nips
+ ! ### Nips
+ ! Drops the second stack item
{ nip [ load0 1 push-down0 ] }
+ ! Drops the second and third stack items
{ 2nip [ load0 2 push-down0 ] }
- ! ! ### Swaps
+ ! ### Swaps
+ ! Rotates the top three elements of the stack (1st -> 3rd)
{ -rot [ pop0 load2/1* store0/2 push1 ] }
+ ! Rotates the top three elements of the stack (1st -> 2nd)
{ rot [ pop0 load2/1* store1/0 push2 ] }
+ ! Swaps the top two elements of the stack
{ swap [ load1/0 store0/1 ] }
+ ! Swaps the second and third elements of the stack
{ swapd [ load2/1 store1/2 ] }
! ## Signal handling
DEFER: stack-reg
+! these are all windows-only functions.
+! NO-OPs appear to be correct on UNIX.
: jit-save-tib ( -- ) ;
: jit-restore-tib ( -- ) ;
: jit-update-tib ( ctx-reg -- ) drop ;
! Copyright (C) 2008, 2010 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
USING: assocs bootstrap.image checksums checksums.md5
-http.client http.download io.files kernel math.parser splitting
+hex-strings http.client http.download io.files kernel splitting
urls ;
IN: bootstrap.image.download
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2015 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: arrays bootstrap.image checksums checksums.openssl io
-io.directories io.encodings.ascii io.encodings.utf8 io.files
-io.files.temp io.files.unique io.launcher io.pathnames kernel
-make math.parser namespaces sequences splitting system unicode ;
+USING: arrays bootstrap.image checksums checksums.openssl
+hex-strings io io.directories io.encodings.ascii
+io.encodings.utf8 io.files io.files.temp io.files.unique
+io.launcher io.pathnames kernel make namespaces sequences
+splitting system unicode ;
IN: bootstrap.image.upload
SYMBOL: upload-images-destination
USING: accessors arrays classes.tuple combinators
combinators.short-circuit kernel literals math math.constants
math.functions math.intervals math.order math.statistics
-sequences slots.syntax system vocabs vocabs.loader ;
+sequences system vocabs vocabs.loader ;
FROM: ranges => [a..b) ;
IN: calendar
month>> 3 /mod [ drop 1 + ] unless-zero ; inline
: same-quarter? ( ts1 ts2 -- ? )
- [ [ year>> ] [ quarter ] bi 2array ] same? ;
+ {
+ [ [ year>> ] same? ]
+ [ [ quarter ] same? ]
+ } 2&& ;
: same-month? ( ts1 ts2 -- ? )
- [ slots{ year month } ] same? ;
+ {
+ [ [ year>> ] same? ]
+ [ [ month>> ] same? ]
+ } 2&& ;
:: (day-of-year) ( $year $month $day -- n )
$month cumulative-day-counts nth $day + {
>date< (day-of-year) ;
: same-day? ( ts1 ts2 -- ? )
- [ slots{ year month day } ] same? ;
+ {
+ [ [ year>> ] same? ]
+ [ [ month>> ] same? ]
+ [ [ day>> ] same? ]
+ } 2&& ;
: same-day-of-year? ( ts1 ts2 -- ? )
- [ slots{ month day } ] same? ;
+ {
+ [ [ month>> ] same? ]
+ [ [ day>> ] same? ]
+ } 2&& ;
: (day-of-week) ( year month day -- n )
! Zeller Congruence
[ [ year>> ] [ week-number ] bi 2array ] same? ;
: same-hour? ( ts1 ts2 -- ? )
- [ >gmt slots{ year month day hour } ] same? ;
+ [ >gmt ] bi@ {
+ [ [ year>> ] same? ]
+ [ [ month>> ] same? ]
+ [ [ day>> ] same? ]
+ [ [ hour>> ] same? ]
+ } 2&& ;
: same-minute? ( ts1 ts2 -- ? )
- [ >gmt slots{ year month day hour minute } ] same? ;
+ [ >gmt ] bi@ {
+ [ [ year>> ] same? ]
+ [ [ month>> ] same? ]
+ [ [ day>> ] same? ]
+ [ [ hour>> ] same? ]
+ [ [ minute>> ] same? ]
+ } 2&& ;
: same-second? ( ts1 ts2 -- ? )
- [ >gmt ] bi@
- {
+ [ >gmt ] bi@ {
[ [ second>> floor ] bi@ = ]
- [ [ slots{ year month day hour minute } ] same? ]
+ [ same-minute? ]
} 2&& ;
<PRIVATE
{ "about a minute ago" } [ 60 relative-time ] unit-test
{ "about a minute ago" } [ 90 relative-time ] unit-test
{ "4 minutes ago" } [ 270 relative-time ] unit-test
+
+{ "1 minute" } [ 60 seconds duration>human-readable ] unit-test
+{ "1 hour" } [ 1 hours duration>human-readable ] unit-test
+{ "3 hours" } [ 3 hours duration>human-readable ] unit-test
+{ "2 minutes and 3 seconds" } [ 123 seconds duration>human-readable ] unit-test
+{ "20 minutes and 34 seconds" } [ 1234 seconds duration>human-readable ] unit-test
+{ "3 hours, 25 minutes and 45 seconds" } [ 12345 seconds duration>human-readable ] unit-test
: duration>human-readable ( duration -- string )
[
- [
- duration>years >integer
- [
- [ number>string write ]
- [ 1 > " years, " " year, " ? write ] bi
- ] unless-zero
- ] [
- duration>days >integer 365 mod
+ {
[
- [ number>string write ]
- [ 1 > " days, " " day, " ? write ] bi
- ] unless-zero
- ] [ duration>hms write ] tri
- ] with-string-writer ;
+ duration>years >integer
+ [
+ [ number>string ]
+ [ 1 > " years" " year" ? append , ] bi
+ ] unless-zero
+ ] [
+ duration>days >integer 365 mod
+ [
+ [ number>string ]
+ [ 1 > " days" " day" ? append , ] bi
+ ] unless-zero
+ ] [
+ duration>hours >integer 24 mod
+ [
+ [ number>string ]
+ [ 1 > " hours" " hour" ? append , ] bi
+ ] unless-zero
+ ] [
+ duration>minutes >integer 60 mod
+ [
+ [ number>string ]
+ [ 1 > " minutes" " minute" ? append , ] bi
+ ] unless-zero
+ ] [
+ duration>seconds >integer 60 mod
+ [
+ number>string " seconds" append ,
+ ] unless-zero
+ ]
+ } cleave
+ ] { } make [ "0 seconds" ] [
+ unclip-last-slice over empty? [ nip ] [
+ [ ", " join ] [ " and " glue ] bi*
+ ] if
+ ] if-empty ;
GENERIC: elapsed-time ( seconds -- string )
-USING: arrays assocs calendar cbor kernel literals math
-math.parser ranges tools.test urls ;
+USING: arrays assocs calendar cbor hex-strings kernel literals
+math ranges tools.test urls ;
{
{ 0 "00" }
-USING: checksums.hmac checksums.md5 checksums.sha math.parser
+USING: checksums.hmac checksums.md5 checksums.sha hex-strings
sequences strings tools.test ;
{
! Copyright (C) 2008 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors arrays checksums io.encodings.binary
-io.files io.streams.byte-array kernel math math.vectors
-sequences ;
+USING: accessors arrays checksums io.encodings.binary io.files
+io.streams.byte-array kernel math math.vectors sequences ;
IN: checksums.hmac
SLOT: block-size
! Copyright (C) 2009 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: byte-arrays checksums checksums.common checksums.md5
-io.encodings.binary io.streams.byte-array kernel math.parser
-sequences tools.test ;
+USING: byte-arrays checksums checksums.md5 hex-strings
+io.encodings.binary io.streams.byte-array kernel sequences
+tools.test ;
{ "d41d8cd98f00b204e9800998ecf8427e" } [ "" >byte-array md5 checksum-bytes bytes>hex-string ] unit-test
{ "0cc175b9c0f1b6a831c399e269772661" } [ "a" >byte-array md5 checksum-bytes bytes>hex-string ] unit-test
"An error thrown if the digest name is unrecognized:"
{ $subsections unknown-digest }
"An example where we compute the SHA1 checksum of a string using the OpenSSL implementation of SHA1:"
-{ $example "USING: byte-arrays checksums checksums.openssl math.parser ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes bytes>hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" }
+{ $example "USING: byte-arrays checksums checksums.openssl hex-strings ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes bytes>hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" }
"If we use the Factor implementation, we get the same result, just slightly slower:"
-{ $example "USING: byte-arrays checksums checksums.sha math.parser ;" "\"hello world\" >byte-array sha1 checksum-bytes bytes>hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" } ;
+{ $example "USING: byte-arrays checksums checksums.sha hex-strings ;" "\"hello world\" >byte-array sha1 checksum-bytes bytes>hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" } ;
ABOUT: "checksums.openssl"
-USING: arrays checksums checksums.common checksums.sha
-checksums.sha.private io.encodings.binary io.streams.byte-array
-kernel math.parser sequences tools.test random ;
+USING: arrays checksums checksums.sha checksums.sha.private
+hex-strings io.encodings.binary io.streams.byte-array kernel
+random sequences tools.test ;
IN: checksums.sha.tests
{ "a9993e364706816aba3e25717850c26c9cd0d89d" } [ "abc" sha1 checksum-bytes bytes>hex-string ] unit-test
HELP: rc-absolute-cell
{ $description "Indicates that the relocation is a cell-sized absolute address to an object in the VM." } ;
+HELP: rc-relative-arm64-branch
+{ $description "Relative address stored, divided by four, in bits 25:0 of an ARM64 instruction." } ;
+
+HELP: rc-relative-arm64-bcond
+{ $description "Relative address stored, divided by four, in bits 23:5 of an ARM64 instruction." } ;
+
+HELP: rc-absolute-arm64-movz
+{ $description "Absolute address stored in bits 20:5 of an ARM64 instruction." } ;
+
+HELP: rc-relative-cell
+{ $description "Indicates that the relocation is a cell-sized relative address to an object in the VM." } ;
+
+
HELP: rt-cards-offset
{ $description "Relocation offset type for the cards table." }
{ $see-also rel-cards-offset } ;
rc-absolute-2
rc-absolute-1
rc-absolute-ppc-2/2/2/2
+ rc-relative-arm64-branch
+ rc-relative-arm64-bcond
+ rc-absolute-arm64-movz
+ rc-relative-cell
}
"Relocation types:"
{ $subsections
CONSTANT: rc-absolute-ppc-2/2/2/2 12
CONSTANT: rc-relative-arm64-branch 13
CONSTANT: rc-relative-arm64-bcond 14
+CONSTANT: rc-absolute-arm64-movz 15
+CONSTANT: rc-relative-cell 16
CONSTANT: rt-dlsym 0
CONSTANT: rt-entry-point 1
: LDUR ( simm9 Rn Rt -- ) 2bw [ swap 9 ?sbits ] 2dip LDUR-encode ;
-: LSLi ( uimm6 Rn Rd -- ) 2bw [ tuck [ dup ] 2dip 6 ?ubits ] 2dip LSLi-encode ;
+: LSLi ( uimm6 Rn Rd -- ) 2bw 2bw [ spin 6 ?ubits [ 64 swap - ] [ 63 swap - ] bi ]
+ 2dip LSLi-encode ;
: LSLr ( Rm Rn Rd -- ) 3bw LSLr-encode ;
: LSRi ( uimm6 Rn Rd -- ) 2bw [ tuck [ dup ] 2dip 6 ?ubits ] 2dip LSRi-encode ;
: SVC ( uimm16 -- ) 16 ?ubits SVC-encode ;
: TSTi ( imm64 Rn -- ) 1bw [ swap encode-bitmask ] dip TSTi-encode ;
+
+: UXTB ( Rn Rd -- ) UXTB-encode ;
M: object value ;
: arm-bitfield ( seq -- assoc )
- [ current-vocab name>> ?lookup-word ] map
- [ dup width ] map>alist
- dup values [ f = ] any? [ throw ] when ;
+ [ current-vocab name>> ?lookup-word ] map ! looks up the fields associated with the effect labels
+ [ dup width ] map>alist ! creates a list of { field bitwidth } pairs
+ dup values [ f = ] any? [ throw ] when ; ! if any have no assigned bitwidth, throw.
ERROR: bad-instruction values ;
SYNTAX: ARM-INSTRUCTION:
- scan-new-word
- scan-effect
+ scan-new-word ! scans in the name given
+ scan-effect ! scans in the effect given (effect objects hold input and output sequences)
[
- in>> arm-bitfield
- [ keys [ value ] map ]
- [ values 32 [ - ] accumulate* ] bi zip
- dup last second 0 = [ bad-instruction ] unless
- '[ _ bitfield* 4 >le % ]
+ in>> arm-bitfield ! generates a list of { field bitwidth } pairs from the input
+ [ keys [ value ] map ] ! gets the fields back
+ ! for each field, how many bits are left in the instr after it?
+ [ values 32 [ - ] accumulate* ] bi zip ! then combines into another assoc
+ dup last second 0 = [ bad-instruction ] unless ! and there better be 0 bits left after the last field
+ '[ _ bitfield* 4 >le % ] ! this quot is the actual word effect
] [ in>> [ string>number ] reject { } <effect> ] bi define-declared ;
>>
ARM-INSTRUCTION: ANDSsr-encode ( bw 11 01010 shift2 0 Rm imm6 Rn Rd -- )
! ASR (immediate): Arithmetic Shift Right (immediate): an alias of SBFM.
-ARM-INSTRUCTION: ASRi-encode ( bw 00 100110 0 immr 011111 Rn Rd -- )
+ARM-INSTRUCTION: ASRi-encode ( bw 00 100110 1 immr 111111 Rn Rd -- )
! ASR (register): Arithmetic Shift Right (register): an alias of ASRV.
ARM-INSTRUCTION: ASRr-encode ( bw 0 0 11010110 Rm 0010 10 Rn Rd -- )
ARM-INSTRUCTION: LDRuoff-encode ( 1 bw 111 0 01 01 imm12 Rn Rt -- )
! LDR (literal): Load Register (literal).
-ARM-INSTRUCTION: LDRl-encode ( 1 bw 011 0 00 imm19 Rt -- )
+ARM-INSTRUCTION: LDRl-encode ( 0 bw 011 0 00 imm19 Rt -- )
! LDR (register): Load Register (register).
ARM-INSTRUCTION: LDRr-encode ( 1 bw 111 0 00 01 1 Rm option3 S 1 0 Rn Rt -- )
ARM-INSTRUCTION: LDXRH-encode ( 01 001000 0 1 0 11111 0 11111 Rn Rt -- )
! LSL (immediate): Logical Shift Left (immediate): an alias of UBFM.
-ARM-INSTRUCTION: LSLi-encode ( bw 10 100110 bw immr bw 00000 Rn Rd -- )
+ARM-INSTRUCTION: LSLi-encode ( bw 10 100110 bw immr imms Rn Rd -- )
! LSL (register): Logical Shift Left (register): an alias of LSLV.
ARM-INSTRUCTION: LSLr-encode ( bw 0 0 11010110 Rm 0010 00 Rn Rd -- )
! Copyright (C) 2017 John Benediktsson, Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
USING: ascii assocs checksums checksums.sha combinators
-kernel math math.functions math.parser ranges
-math.statistics sequences sets sorting splitting strings uuid ;
+hex-strings kernel math math.functions math.parser
+math.statistics ranges sequences sets sorting splitting strings
+uuid ;
IN: escape-strings
: find-escapes ( str -- set )
! Copyright (C) 2019 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors checksums checksums.sha documents
-escape-strings kernel math.parser models sequences ui ui.gadgets
+escape-strings hex-strings kernel models sequences ui ui.gadgets
ui.gadgets.editors ui.gadgets.labeled ui.gadgets.scrollers
ui.gadgets.tracks ;
IN: escape-strings.ui
format-fast-decimal?
[ "f" format-float-fast ] [ format-decimal-simple ] if ;
-EBNF: parse-printf [=[
+EBNF: format-directive [=[
zero = "0" => [[ CHAR: 0 ]]
char = "'" (.) => [[ second ]]
assocs = "[%" types ": %" types " %]" => [[ [ second ] [ fourth ] bi '[ [ _ _ bi* ":" glue ] { } assoc>map ", " join "{ " " }" surround ] ]]
-formats = "%" (types|fmt-%|lists|assocs|unknown) => [[ second ]]
+formats = (types|fmt-%|lists|assocs|unknown)
+]=]
+EBNF: parse-printf [=[
+formats = "%"~ <foreign format-directive formats>
plain-text = [^%]+ => [[ >string ]]
-
text = (formats|plain-text)*
-
]=]
: printf-quot ( format-string -- format-quot n )
! See https://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes.mixin classes.parser
classes.singleton classes.tuple classes.tuple.parser combinators
-effects.parser fry functors.backend generic generic.parser
-interpolate io.streams.string kernel lexer locals.parser
-locals.types macros make namespaces parser quotations sequences
-vocabs.parser words words.symbol ;
-
+effects.parser functors.backend generic generic.parser io
+io.streams.string kernel lexer locals.parser locals.types macros
+make namespaces parser present quotations sequences splitting
+strings vocabs.parser words words.symbol ;
IN: functors
! This is a hack
FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } suffix! ;
+: (parse-interpolate) ( str -- )
+ [
+ "${" split1-slice [
+ [ >string '[ _ write ] , ] unless-empty
+ ] [
+ [
+ "}" split1-slice
+ [
+ >string
+ [ search ] [ [ ] ] [ [ get ] ] ?if
+ '[ _ @ present write ] ,
+ ]
+ [ (parse-interpolate) ] bi*
+ ] when*
+ ] bi*
+ ] unless-empty ;
+
+: parse-interpolate ( str -- seq )
+ [ (parse-interpolate) ] { } make concat ;
+
: (INTERPOLATE) ( accum quot -- accum )
- [ scan-token interpolate-locals-quot ] dip
+ [ scan-token parse-interpolate ] dip
'[ _ with-string-writer @ ] suffix! ;
PRIVATE>
! See https://factorcode.org/license.txt for BSD license.
USING: accessors calendar furnace.actions furnace.asides
furnace.auth furnace.auth.login.permits furnace.conversations
-furnace.redirection furnace.utilities html.forms http
-http.server.dispatchers kernel logging math.parser namespaces
-sequences urls validators ;
+furnace.redirection furnace.utilities hex-strings html.forms
+http http.server.dispatchers kernel logging math.parser
+namespaces sequences urls validators ;
IN: furnace.auth.login
SYMBOL: permit-id
--- /dev/null
+Doug Coleman
--- /dev/null
+! Copyright (C) 2024 Doug Coleman.
+! See https://factorcode.org/license.txt for BSD license.
+USING: byte-arrays help.markup help.syntax kernel sequences
+strings ;
+IN: hex-strings
+
+HELP: hex-digit?
+{ $values
+ { "ch" "a character" }
+ { "?" boolean }
+}
+{ $description "Checks if a digit is in hexadecimal format, e.g. a-f A-F and 0-9" }
+{ $examples
+ { $example "USING: hex-strings prettyprint ;" "CHAR: a hex-digit? ." "t" }
+ { $example "USING: hex-strings prettyprint ;" "CHAR: z hex-digit? ." "f" }
+} ;
+
+HELP: hex-string?
+{ $values
+ { "str" string }
+ { "?" boolean }
+}
+{ $description "Tests if a string is a valid hexadecimal string." }
+{ $examples
+ { $example "USING: hex-strings prettyprint ;" "\"abcdef\" hex-string? ." "t" }
+ { $example "USING: hex-strings prettyprint ;" "\"meow\" hex-string? ." "f" }
+} ;
+
+HELP: bytes>hex-string
+{ $values { "bytes" sequence } { "hex-string" string } }
+{ $description "Converts a sequence of bytes (integers in the range [0,255]) to a string of hex numbers in the range [00,ff]." }
+{ $examples
+ { $example "USING: hex-strings prettyprint ;" "B{ 1 2 3 4 } bytes>hex-string ." "\"01020304\"" }
+}
+{ $notes "Numbers are zero-padded on the left." } ;
+
+HELP: hex-string>bytes
+{ $values { "hex-string" sequence } { "bytes" byte-array } }
+{ $description "Converts a sequence of hex numbers in the range [00,ff] to a sequence of bytes (integers in the range [0,255])." }
+{ $examples
+ { $example "USING: hex-strings prettyprint ;" "\"cafebabe\" hex-string>bytes ." "B{ 202 254 186 190 }" }
+} ;
+
+{ bytes>hex-string hex-string>bytes } related-words
+
+ARTICLE: "hex-strings" "Hex Strings"
+"The " { $vocab-link "hex-strings" } " vocabulary provides words for converting between byte sequences and hexadecimal strings. It also provides predicate words for checking if a string is a valid hexadecimal string for various checksums." $nl
+"Converting between byte sequences and hexadecimal strings:"
+{ $subsections
+ bytes>hex-string
+ hex-string>bytes
+}
+"Check if a string is a known checksum hex string:"
+{ $subsections
+ md5-string?
+ sha1-string?
+ sha224-string?
+ sha256-string?
+ sha384-string?
+ sha512-string?
+} ;
+
+ABOUT: "hex-strings"
--- /dev/null
+! Copyright (C) 2024 Doug Coleman.
+! See https://factorcode.org/license.txt for BSD license.
+USING: hex-strings tools.test ;
+IN: hex-strings.tests
+
+{ "deadbeef" } [ B{ 222 173 190 239 } bytes>hex-string ] unit-test
+{ B{ 222 173 190 239 } } [ "deADbeEF" hex-string>bytes ] unit-test
+[ "0" hex-string>bytes ] [ invalid-hex-string-length? ] must-fail-with
+
+{ f } [ "asdf" hex-string? ] unit-test
+{ t } [ "adfAE12309812861cdef" hex-string? ] unit-test
+{ t } [ "" hex-string? ] unit-test
+{ t } [ f hex-string? ] unit-test
--- /dev/null
+! Copyright (C) 2024 Doug Coleman.
+! See https://factorcode.org/license.txt for BSD license.
+USING: byte-arrays combinators.short-circuit kernel math
+math.order math.parser sequences sequences.private strings ;
+IN: hex-strings
+
+: hex-digit? ( ch -- ? )
+ {
+ [ CHAR: A CHAR: F between? ]
+ [ CHAR: a CHAR: f between? ]
+ [ CHAR: 0 CHAR: 9 between? ]
+ } 1|| ;
+
+: hex-string? ( str -- ? )
+ [ hex-digit? ] all? ;
+
+: md5-string? ( str -- ? ) { [ length 32 = ] [ hex-string? ] } 1&& ;
+: sha1-string? ( str -- ? ) { [ length 40 = ] [ hex-string? ] } 1&& ;
+: sha224-string? ( str -- ? ) { [ length 56 = ] [ hex-string? ] } 1&& ;
+: sha256-string? ( str -- ? ) { [ length 64 = ] [ hex-string? ] } 1&& ;
+: sha384-string? ( str -- ? ) { [ length 96 = ] [ hex-string? ] } 1&& ;
+: sha512-string? ( str -- ? ) { [ length 128 = ] [ hex-string? ] } 1&& ;
+
+ERROR: invalid-hex-string-length n ;
+
+: hex-string>bytes ( hex-string -- bytes )
+ dup length dup even? [ invalid-hex-string-length ] unless 2/ <byte-array> [
+ [
+ [ digit> ] 2dip over even? [
+ [ 16 * ] [ 2/ ] [ set-nth-unsafe ] tri*
+ ] [
+ [ 2/ ] [ [ + ] change-nth-unsafe ] bi*
+ ] if
+ ] curry each-index
+ ] keep ;
+
+: bytes>hex-string ( bytes -- hex-string )
+ dup length 2 * CHAR: 0 <string> [
+ [
+ [ 16 /mod [ >digit ] bi@ ]
+ [ 2 * dup 1 + ]
+ [ [ set-nth-unsafe ] curry bi-curry@ bi* ] tri*
+ ] curry each-index
+ ] keep ;
HELP: interpolate
{ $values { "str" string } }
-{ $description "String interpolation using named variables and/or stack arguments, writing to the " { $link output-stream } "." }
+{ $description "String interpolation using named variables and/or stack arguments, writing to the " { $link output-stream } ". Format directives from the " { $vocab-link "formatting" } " vocabulary can be used as well." }
{ $notes "Stack arguments are numbered from the top of the stack, or provided anonymously by order of arguments." }
{ $examples
{ $example
"\"Mr.\" \"Anderson\"" "\"Hello, ${} ${}\" interpolate"
"Hello, Mr. Anderson"
}
+ { $example
+ "USING: interpolate ;"
+ "1.2345 \"${:011.5f}\" interpolate"
+ "00001.23450"
+ }
} ;
HELP: interpolate>string
! Copyright (C) 2008 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: interpolate io.streams.string namespaces tools.test locals ;
+USING: formatting interpolate io.streams.string namespaces tools.test ;
{ "A B" } [ "A" "B" "${1} ${0}" interpolate>string ] unit-test
{ "B A" } [ "A" "B" "${0} ${1}" interpolate>string ] unit-test
] unit-test
{ "hello, world" } [ "world" I"hello, ${0}" ] unit-test
+
+{ "hello, ####world" } [ "world" I"hello, ${0:'#9s}" ] unit-test
+
+{ "0123.4500" } [ 123.45 I"${:09.4f}" ] unit-test
+
+[ I"${:ABCD}" ] [ unknown-format-directive? ] must-fail-with
! Copyright (C) 2008, 2009 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors fry generalizations io io.streams.string kernel
-make math math.order math.parser multiline namespaces present
-sequences splitting strings strings.parser vocabs.parser ;
+USING: accessors arrays assocs combinators formatting
+formatting.private fry generalizations io io.streams.string
+kernel make math math.order math.parser multiline namespaces
+present quotations sequences splitting strings strings.parser
+vocabs.parser ;
IN: interpolate
<PRIVATE
: (parse-interpolate) ( str -- )
[
"${" split1-slice [
- [ >string , ] unless-empty
+ [ >string [ ] 2array , ] unless-empty
] [
[
"}" split1-slice
[
- >string
- [ string>number ]
- [ 1 + stack-var boa ]
- [ [ anon-var new ] [ named-var boa ] if-empty ] ?if ,
+ >string ":" split1 [
+ [ string>number ]
+ [ 1 + stack-var boa ]
+ [ [ anon-var new ] [ named-var boa ] if-empty ] ?if
+ ] [
+ [ [ present ] ] [ format-directive ] if-empty
+ ] bi* 2array ,
]
[ (parse-interpolate) ] bi*
] when*
: deanonymize ( seq -- seq' )
0 over <reversed> [
- dup anon-var? [
- drop 1 + dup stack-var boa
+ dup first anon-var? [
+ [ 1 + dup stack-var boa ] dip second 2array
] when
] map! 2drop ;
: max-stack-var ( seq -- n/f )
f [
- dup stack-var? [ n>> [ or ] keep max ] [ drop ] if
+ first dup stack-var? [ n>> [ or ] keep max ] [ drop ] if
] reduce ;
:: (interpolate-quot) ( str quot -- quot' )
args max-stack-var :> vars
args [
- dup named-var? [
- name>> quot call '[ _ @ present write ]
- ] [
- dup stack-var? [
- n>> '[ _ npick present write ]
- ] [
- '[ _ write ]
- ] if
- ] if
- ] map concat
+ [
+ {
+ { [ dup named-var? ] [ name>> quot call '[ _ @ ] ] }
+ { [ dup stack-var? ] [ n>> '[ _ npick ] ] }
+ [ 1quotation ]
+ } cond
+ ] dip '[ @ @ write ]
+ ] { } assoc>map concat
vars [
'[ _ ndrop ] append
" } switch ;" }
{ $see-also undo } ;
+HELP: under
+{ $values { "invertible-quot" quotation } { "quot" quotation } }
+{ $description "Applies " { $snippet "invertible-quot" } ", then " { $snippet "quot" } " and finally the inverse of " { $snippet "invertible-quot" } "." }
+{ $examples
+ "Round a decimal number to two decimals:"
+ { $example
+ "USING: inverse math math.functions prettyprint ;"
+ "123.456 [ 100 * ] [ round ] under ."
+ "123.46"
+ }
+} ;
+
ARTICLE: { "inverse" "intro" } "Invertible quotations"
"The inverse vocab defines a way to 'undo' quotations, and builds a pattern matching framework on that basis. A quotation can be inverted by reversing it and inverting each word. To define the inverse for particular word, use"
{ $subsections
{ 0 } [ { 1 2 } [ [ 1 + 2 ] { } output>sequence ] undo ] unit-test
{ { 0 1 } } [ 1 2 [ [ [ 1 + ] bi@ ] input<sequence ] undo ] unit-test
+
+{ 123.46 } [ 123.456 [ 100 * ] [ round ] under ] unit-test
SYNTAX: INVERSE: scan-word parse-definition define-inverse ;
SYNTAX: DUAL: scan-word scan-word define-dual ;
+
+MACRO: under ( invertible-quot quot -- quot )
+ over [undo] '[ @ @ @ ] ;
dup parent-directory 2dup = [ 2drop f ] [ nip ] if ;
: containing-directory ( path -- path' )
- dup file-info directory? [ parent-directory ] unless ;
+ dup ?file-info directory? [ parent-directory ] unless ;
: ?qualified-directory-files ( path -- seq )
[ qualified-directory-files ]
PRIVATE>
: directory? ( path/info -- ? )
- >file-info type>> +directory+ = ;
+ [ >file-info type>> +directory+ = ] ?call ;
: regular-file? ( path/info -- ? )
- >file-info type>> +regular-file+ = ;
+ [ >file-info type>> +regular-file+ = ] ?call ;
: symbolic-link? ( path/info -- ? )
- >file-info type>> +symbolic-link+ = ;
+ [ >file-info type>> +symbolic-link+ = ] ?call ;
: sparse-file? ( path/info -- ? )
- >file-info [ size-on-disk>> ] [ size>> ] bi < ;
+ [ >file-info [ size-on-disk>> ] [ size>> ] bi < ] ?call ;
! File systems
HOOK: file-systems os ( -- array )
normalize-separators
] [
absolute-path
- normalize-separators
- prepend-unicode-prefix
+ [ normalize-separators prepend-unicode-prefix ] ?call
] if ;
M: windows home
! Copyright (C) 2012-2014 John Benediktsson
! See https://factorcode.org/license.txt for BSD license
-USING: arrays byte-arrays combinators combinators.short-circuit
-endian grouping kernel math math.bitwise math.parser regexp
+USING: byte-arrays combinators combinators.short-circuit endian
+grouping hex-strings kernel math math.bitwise math.parser regexp
sequences splitting ;
IN: ip-parser
! Copyright (C) 2009 Daniel Ehrenberg
! See https://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup math sequences ;
+USING: help.syntax help.markup kernel math sequences ;
IN: math.bits
ABOUT: "math.bits"
<bits>
make-bits
bits>number
+}
+"If you need binary digits instead of " { $link boolean } ", then you can use these:"
+{ $subsections
+ binary-bits
+ <binary-bits>
+ make-binary-bits
} ;
HELP: bits
{ $values { "seq" sequence } { "number" integer } }
{ $description "Converts a sequence of booleans in ascending significance into a number." } ;
{ make-bits bits>number } related-words
+
+HELP: binary-bits
+{ $class-description "Tuple representing a number as a virtual sequence of binary digits. The first bit is the least significant bit. Constructors are " { $link <binary-bits> } " or " { $link make-binary-bits } "." } ;
+
+HELP: <binary-bits>
+{ $values { "number" integer } { "length" integer } { "binary-bits" binary-bits } }
+{ $description "Constructor for a " { $link binary-bits } " tuple." } ;
+
+HELP: make-binary-bits
+{ $values { "number" integer } { "binary-bits" binary-bits } }
+{ $description "Creates a sequence of " { $link binary-bits } " in ascending significance. Throws an error on negative numbers." }
+{ $examples
+ { $example "USING: math.bits prettyprint arrays ;" "0b1101 make-binary-bits >array ." "{ 1 0 1 1 }" }
+ { $example "USING: math.bits prettyprint arrays ;" "64 make-binary-bits >array ." "{ 0 0 0 0 0 0 1 }" }
+} ;
+{ <binary-bits> make-binary-bits } related-words
{ 6 } [ 6 make-bits bits>number ] unit-test
{ 6 } [ 6 3 <bits> >array bits>number ] unit-test
+
+{ { 0 } } [ 0 make-binary-bits >array ] unit-test
+{ { 1 0 1 0 1 1 } } [ 0b110101 make-binary-bits >array ] unit-test
: bits>number ( seq -- number )
<reversed> 0 [ [ 1 shift ] dip [ 1 + ] when ] reduce ;
+
+TUPLE: binary-bits < bits ;
+
+C: <binary-bits> binary-bits
+
+M: binary-bits nth-unsafe call-next-method 1 0 ? ; inline
+
+INSTANCE: binary-bits virtual-sequence
+
+: make-binary-bits ( number -- binary-bits )
+ assert-non-negative
+ [ T{ binary-bits { number 0 } { length 1 } } ]
+ [ dup abs log2 1 + <binary-bits> ] if-zero ; inline
! Copyright (C) 2010 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors assocs base64 calendar checksums.hmac
-checksums.sha http http.client kernel make math math.parser
+checksums.sha hex-strings http http.client kernel make math
namespaces present random sequences sorting strings
urls.encoding urls.private ;
IN: oauth1
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes combinators
-combinators.short-circuit combinators.smart kernel math
-math.order sequences sets unicode unicode.data ;
+combinators.short-circuit combinators.smart hex-strings kernel
+math math.order sequences sets unicode unicode.data ;
FROM: ascii => ascii? ;
IN: regexp.classes
M: control-character-class class-member?
drop control? ; inline
-: hex-digit? ( ch -- ? )
- {
- [ CHAR: A CHAR: F between? ]
- [ CHAR: a CHAR: f between? ]
- [ CHAR: 0 CHAR: 9 between? ]
- } 1|| ;
-
M: hex-digit-class class-member?
drop hex-digit? ; inline
{ $class-description "A class of virtual sequences that present the cartesian product of their underlying set of sequences. Product sequences are constructed with the " { $link <product-sequence> } " word." }
{ $examples
{ $example "USING: arrays prettyprint sequences.product ;
-{ { 1 2 3 } { \"a\" \"b\" \"c\" } } <product-sequence> >array .
-" "{
+{ { 1 2 3 } { \"a\" \"b\" \"c\" } } <product-sequence> >array ."
+"{
{ 1 \"a\" }
- { 2 \"a\" }
- { 3 \"a\" }
{ 1 \"b\" }
- { 2 \"b\" }
- { 3 \"b\" }
{ 1 \"c\" }
+ { 2 \"a\" }
+ { 2 \"b\" }
{ 2 \"c\" }
+ { 3 \"a\" }
+ { 3 \"b\" }
{ 3 \"c\" }
}" } } ;
{ { 1 2 3 } { \"a\" \"b\" \"c\" } } <product-sequence> >array ."
"{
{ 1 \"a\" }
- { 2 \"a\" }
- { 3 \"a\" }
{ 1 \"b\" }
- { 2 \"b\" }
- { 3 \"b\" }
{ 1 \"c\" }
+ { 2 \"a\" }
+ { 2 \"b\" }
{ 2 \"c\" }
+ { 3 \"a\" }
+ { 3 \"b\" }
{ 3 \"c\" }
}" } } ;
! See https://factorcode.org/license.txt for BSD license.
USING: arrays kernel make math sequences sequences.product tools.test ;
-{ { { 0 "a" } { 1 "a" } { 2 "a" } { 0 "b" } { 1 "b" } { 2 "b" } } }
+{ { { 0 "a" } { 0 "b" } { 1 "a" } { 1 "b" } { 2 "a" } { 2 "b" } } }
[ { { 0 1 2 } { "a" "b" } } <product-sequence> >array ] unit-test
-{ { "a" "aa" "aaa" "b" "bb" "bbb" } }
+{ { "a" "b" "aa" "bb" "aaa" "bbb" } }
[ { { 1 2 3 } { "a" "b" } } [ first2 <repetition> concat ] product-map ] unit-test
{
{
- { 0 "a" t } { 1 "a" t } { 2 "a" t } { 0 "b" t } { 1 "b" t } { 2 "b" t }
- { 0 "a" f } { 1 "a" f } { 2 "a" f } { 0 "b" f } { 1 "b" f } { 2 "b" f }
+ { 0 "a" t }
+ { 0 "a" f }
+ { 0 "b" t }
+ { 0 "b" f }
+ { 1 "a" t }
+ { 1 "a" f }
+ { 1 "b" t }
+ { 1 "b" f }
+ { 2 "a" t }
+ { 2 "a" f }
+ { 2 "b" t }
+ { 2 "b" f }
}
} [ { { 0 1 2 } { "a" "b" } { t f } } [ ] product-map ] unit-test
-{ "a1b1c1a2b2c2" } [
+{ "a1a2b1b2c1c2" } [
[
{ { "a" "b" "c" } { "1" "2" } }
[ [ % ] each ] product-each
! Copyright (C) 2009 Joe Groff.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs kernel math sequences
-sequences.private typed ;
+USING: accessors arrays assocs combinators.short-circuit kernel
+math sequences sequences.private ;
IN: sequences.product
TUPLE: product-sequence
<PRIVATE
-TYPED: product-ns ( n lengths: array -- ns )
- [ /mod ] map nip ;
+: product-ns ( n lengths -- ns )
+ <reversed> [ /mod ] map nip <reversed> ; inline
-TYPED: product-nths ( ns: array seqs -- nths )
- [ nth-unsafe ] { } 2map-as ;
+: product-nths ( ns seqs -- nths )
+ [ nth-unsafe ] { } 2map-as ; inline
-: product@ ( n product-sequence -- ns seqs )
- [ lengths>> product-ns ] [ nip sequences>> ] 2bi ;
-
-:: (carry-n) ( ns lengths i j -- )
- i 1 + j = [
- i ns nth-unsafe i lengths nth-unsafe = [
- 0 i ns set-nth-unsafe
- ns lengths i 1 +
- dup ns [ 1 + ] change-nth-unsafe
- j (carry-n)
- ] when
- ] unless ; inline recursive
-
-: carry-ns ( ns lengths -- )
- 0 pick length integer>fixnum-strict (carry-n) ; inline
-
-: product-iter ( ns lengths -- )
- [ 0 over [ 1 + ] change-nth-unsafe ] dip carry-ns ; inline
+PRIVATE>
-: start-product-iter ( sequences -- ns lengths )
- [ length 0 <array> ] [ [ length ] map ] bi ; inline
+M: product-sequence nth
+ [ lengths>> product-ns ] [ sequences>> product-nths ] bi ;
-: end-product-iter? ( ns lengths -- ? )
- [ last-unsafe ] same? ; inline
+<PRIVATE
: product-length ( sequences -- length )
- [ length ] [ * ] map-reduce ; inline
+ [ length ] [ * ] map-reduce integer>fixnum-strict ; inline
-PRIVATE>
+:: (product-each) ( ... ns sequences k quot: ( ... seq -- ... ) -- ... )
+ k sequences length 1 - = :> done?
+ k sequences nth-unsafe [
+ k ns set-nth-unsafe
+ ns done? quot [
+ sequences k 1 + quot (product-each)
+ ] if
+ ] each ; inline recursive
-M: product-sequence nth
- product@ product-nths ;
+PRIVATE>
:: product-each ( ... sequences quot: ( ... seq -- ... ) -- ... )
- sequences start-product-iter :> ( ns lengths )
- lengths [ 0 = ] any? [
- [ ns lengths end-product-iter? ]
- [ ns sequences product-nths quot call ns lengths product-iter ] until
+ sequences [ empty? ] any? [
+ sequences length f <array>
+ sequences >array 0 quot (product-each)
] unless ; inline
:: product-map-as ( ... sequences quot: ( ... seq -- ... value ) exemplar -- ... sequence )
- 0 :> i!
- sequences product-length exemplar
+ sequences >array :> sequences
+ 0 sequences product-length exemplar
[| result |
- sequences [ quot call i result set-nth-unsafe i 1 + i! ] product-each
+ sequences
+ [ clone swap quot dip [ result set-nth-unsafe ] [ 1 + ] bi ]
+ product-each
result
- ] new-like ; inline
+ ] new-like nip ; inline
: product-map ( ... sequences quot: ( ... seq -- ... value ) -- ... sequence )
over product-map-as ; inline
+: all-products ( sequences -- sequences )
+ [ ] product-map ;
+
:: product-map>assoc ( ... sequences quot: ( ... seq -- ... key value ) exemplar -- ... assoc )
- 0 :> i!
- sequences product-length { }
+ 0 sequences product-length { }
[| result |
- sequences [ quot call 2array i result set-nth-unsafe i 1 + i! ] product-each
+ sequences
+ [ clone swap [ quot call 2array ] dip [ result set-nth-unsafe ] [ 1 + ] bi ]
+ product-each
result
- ] new-like exemplar assoc-like ; inline
+ ] new-like exemplar assoc-like nip ; inline
+
+<PRIVATE
+
+:: (product-find) ( ... ns sequences k quot: ( ... seq -- ... ? ) -- ... ? )
+ k sequences length 1 - = :> done?
+ k sequences nth-unsafe [
+ k ns set-nth-unsafe
+ ns done? quot [
+ sequences k 1 + quot (product-find)
+ ] if
+ ] find drop ; inline recursive
+
+PRIVATE>
:: product-find ( ... sequences quot: ( ... seq -- ... ? ) -- ... sequence )
- sequences start-product-iter :> ( ns lengths )
- lengths [ 0 = ] any? [ f ] [
- f [ ns lengths end-product-iter? over or ]
- [ drop ns sequences product-nths quot keep and ns lengths product-iter ] until
+ sequences { [ empty? ] [ [ empty? ] any? ] } 1|| [ f ] [
+ sequences length f <array>
+ [ sequences >array 0 quot (product-find) ] keep and
] if ; inline
! See https://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.data
alien.destructors alien.libraries alien.strings alien.syntax
-arrays classes.struct combinators destructors kernel layouts
-math math.parser namespaces sequences specialized-arrays
-system tools.disassembler.private tools.memory ;
+arrays classes.struct combinators destructors hex-strings kernel
+math namespaces sequences specialized-arrays system
+tools.disassembler.private tools.memory ;
IN: tools.disassembler.capstone
<< "libcapstone" {
SLOT: history
: history-list ( interactor -- alist )
- history>> elements>>
- [ dup string>> H{ { CHAR: \n CHAR: \s } } substitute ] { } map>assoc
- <reversed> ;
+ history>> elements>> [ dup string>> ] { } map>assoc <reversed> ;
: history-completions ( short interactor -- seq )
history-list over empty? [ nip ] [ members completions ] if ;
GENERIC: completion-element ( completion-mode -- element )
M: object completion-element drop word-start-elt ;
-M: history-completion completion-element drop one-line-elt ;
+M: history-completion completion-element drop doc-elt ;
GENERIC: completion-banner ( completion-mode -- string )
! Copyright (C) 2009 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors documents io.styles kernel math math.order
-sequences ;
+USING: accessors continuations documents io io.encodings.utf8
+io.files io.styles kernel math math.order namespaces
+prettyprint.backend prettyprint.config sequences strings.parser ;
IN: ui.tools.listener.history
-TUPLE: history document elements index ;
+TUPLE: history document elements start index ;
+
+CONSTANT: history-file "~/.factor-history"
+
+: read-history ( -- elements )
+ history-file file-exists? [ history-file utf8 file-lines [ unescape-string <input> ] V{ } map-as ] [ V{ } clone ] if ;
+
+: append-history ( history -- )
+ history-file file-exists?
+ [
+ [
+ history-file utf8 [
+ f string-limit? [
+ [ elements>> ] [ start>> ] bi [ string>> f f unparse-string print ] swap each-from
+ ] with-variable
+ ] with-file-appender
+ ] [ [ index>> ] keep start<< ] bi
+ ] [ drop ] if ;
: <history> ( document -- history )
- V{ } clone 0 history boa ;
+ read-history dup length dup history boa ;
<PRIVATE
] unless-empty ;
: com-end ( listener -- )
- input>> interactor-eof ;
+ input>> [ history>> append-history ] [ interactor-eof ] bi ;
: clear-output ( listener -- )
output>> clear-pane ;
if test_programs_installed x86_64-w64-mingw32-gcc x86_64-w64-mingw32-g++; then
[ -z "$CC" ] && CC=x86_64-w64-mingw32-gcc
[ -z "$CXX" ] && CXX=x86_64-w64-mingw32-g++
+ [ -z "$CC_OPT" ] && [ "$LTO" == "1" ] && CC_OPT="-flto=auto"
return
fi
if test_programs_installed i686-w64-mingw32-gcc i686-w64-mingw32-g++; then
[ -z "$CC" ] && CC=i686-w64-mingw32-gcc
[ -z "$CXX" ] && CXX=i686-w64-mingw32-g++
+ [ -z "$CC_OPT" ] && [ "$LTO" == "1" ] && CC_OPT="-flto=auto"
return
fi
fi
if test_programs_installed clang clang++ ; then
[ -z "$CC" ] && CC=clang
[ -z "$CXX" ] && CXX=clang++
+ [ -z "$CC_OPT" ] && [ "$LTO" == "1" ] && CC_OPT="-flto"
return
fi
if test_programs_installed gcc g++ ; then
[ -z "$CC" ] && CC=gcc
[ -z "$CXX" ] && CXX=g++
+ [ -z "$CC_OPT" ] && [ "$LTO" == "1" ] && CC_OPT="-flto=auto"
return
fi
$ECHO "DOWNLOADER_NAME=$DOWNLOADER_NAME"
$ECHO "CC=$CC"
$ECHO "CXX=$CXX"
+ $ECHO "LTO=$LTO"
+ $ECHO "CC_OPT=$CC_OPT"
$ECHO "MAKE=$MAKE"
}
find_os
find_architecture
find_num_cores
+ if [[ $OS != macosx ]] ; then LTO=1; fi # temporarily try out LTO to collect performance data (not working on MacOSX)
set_cc
find_word_size
set_current_branch
}
make_clean() {
- invoke_make clean
+ echo invoke_make clean BUILD_DIR="build-$MAKE_TARGET"
+ invoke_make clean BUILD_DIR="build-$MAKE_TARGET"
}
make_factor() {
$ECHO "Building factor with $NUM_CORES cores"
- invoke_make "CC=$CC" "CXX=$CXX" "$MAKE_TARGET" "-j$NUM_CORES"
+ $ECHO invoke_make "CC=$CC" "CXX=$CXX" "CC_OPT=$CC_OPT" "$MAKE_TARGET" "-j$NUM_CORES"
+ invoke_make "CC=$CC" "CXX=$CXX" "CC_OPT=$CC_OPT" "$MAKE_TARGET" "-j$NUM_CORES"
}
make_clean_factor() {
$ECHO " self-update - git pull, recompile, make local boot image, bootstrap"
$ECHO " quick-update - git pull, refresh-all, save"
$ECHO " update|latest - git pull, recompile, download a boot image, bootstrap"
+ $ECHO " clean - run make clean"
$ECHO " compile - compile the binary"
$ECHO " recompile - recompile the binary"
$ECHO " bootstrap - bootstrap with existing boot image"
self-update) update; make_boot_image; bootstrap ;;
quick-update) update; refresh_image ;;
update|latest) update; download_and_bootstrap ;;
+ clean) find_build_info; make_clean ;;
compile) find_build_info; make_factor ;;
recompile) find_build_info; make_clean; make_factor ;;
bootstrap) get_config_info; bootstrap ;;
[ ascii file-contents ] bi "a" =
] with-test-file
] unit-test
+
+{ f } [ f file-exists? ] unit-test
[ <file-appender> ] dip with-output-stream ; inline
: file-exists? ( path -- ? )
- normalize-path native-string>alien (file-exists?) ;
+ [ normalize-path native-string>alien (file-exists?) ] ?call ;
ERROR: no-such-file path ;
{ "c:/Users" } [ "c:/Users" canonicalize-path ] unit-test
{ "c:/Users" } [ "c:/Users/." canonicalize-path ] unit-test
- { "c:/Users\\foo\\bar" } [ "c:/Users/foo/bar" canonicalize-path ] unit-test
+ { "c:/Users/foo/bar" } [ "c:/Users/foo/bar" canonicalize-path ] unit-test
+ { "C:/foo/bar" } [ "C:\\foo\\bar" canonicalize-path ] unit-test
] [
{ "/" } [ "/" canonicalize-path ] unit-test
{ "/" } [ "/." canonicalize-path ] unit-test
{ "c:\\" } [ "\\\\?\\c:\\\\\\//Users//\\//merlen//" root-path ] unit-test
{ "d:\\" } [ "\\\\?\\d:\\././././././/../../../" root-path ] unit-test
{ "d:\\" } [ "\\\\?\\d:\\merlen\\dog" root-path ] unit-test
+ { "D:\\" } [ "\\\\?\\D:\\merlen\\dog" root-path ] unit-test
] [
{ "/" } [ "/" root-path ] unit-test
{ "/" } [ "//" root-path ] unit-test
! Would be a core/ path except the path already exists in basis
{ "resource:basis/bootstrap/finish-bootstrap.factor" }
[ "bootstrap/finish-bootstrap.factor" vocab-path ] unit-test
+
+{ f } [ f normalize-path ] unit-test
+{ f } [ f absolute-path ] unit-test
SYMBOL: current-directory
+CONSTANT: cross-platform-path-separator "/"
+
: path-separator? ( ch -- ? ) os windows? "/\\" "/" ? member? ;
: path-separator ( -- string ) os windows? "\\" "/" ? ;
M: object normalize-path
absolute-path ;
+M: f absolute-path ;
+
: root-path* ( path -- path' )
dup absolute-path? [
dup [ path-separator? ] find
] keep dup absolute-path? [
[
[ ".." = ] trim-head
- path-separator join
+ cross-platform-path-separator join
] dip root-path prepend-path
] [
- drop path-separator join [ "." ] when-empty
+ drop cross-platform-path-separator join [ "." ] when-empty
] if ;
HOOK: canonicalize-path io-backend ( path -- path' )
HELP: #
{ $values { "n" real } }
{ $description "Appends the string representation of a real number to the end of the sequence being constructed by " { $link make } "." } ;
-
-HELP: bytes>hex-string
-{ $values { "bytes" sequence } { "hex-string" string } }
-{ $description "Converts a sequence of bytes (integers in the range [0,255]) to a string of hex numbers in the range [00,ff]." }
-{ $examples
- { $example "USING: math.parser prettyprint ;" "B{ 1 2 3 4 } bytes>hex-string ." "\"01020304\"" }
-}
-{ $notes "Numbers are zero-padded on the left." } ;
-
-HELP: hex-string>bytes
-{ $values { "hex-string" sequence } { "bytes" byte-array } }
-{ $description "Converts a sequence of hex numbers in the range [00,ff] to a sequence of bytes (integers in the range [0,255])." }
-{ $examples
- { $example "USING: math.parser prettyprint ;" "\"cafebabe\" hex-string>bytes ." "B{ 202 254 186 190 }" }
-} ;
-
-{ bytes>hex-string hex-string>bytes } related-words
{ 1/0. } [ "0x1p300000" string>number ] unit-test
{ 0.0 } [ "0x1p-300000" string>number ] unit-test
-{ "deadbeef" } [ B{ 222 173 190 239 } bytes>hex-string ] unit-test
-{ B{ 222 173 190 239 } } [ "deADbeEF" hex-string>bytes ] unit-test
-[ "0" hex-string>bytes ] [ invalid-hex-string-length? ] must-fail-with
-
{ "143.99999999999997" } [ 0x1.1ffffffffffffp7 number>string ] unit-test
{ "144.0" } [ 0x1.2p7 number>string ] unit-test
{ "144.00000000000003" } [ 0x1.2000000000001p7 number>string ] unit-test
} cond ;
: # ( n -- ) number>string % ; inline
-
-ERROR: invalid-hex-string-length n ;
-
-: hex-string>bytes ( hex-string -- bytes )
- dup length dup even? [ invalid-hex-string-length ] unless 2/ <byte-array> [
- [
- [ digit> ] 2dip over even? [
- [ 16 * ] [ 2/ ] [ set-nth-unsafe ] tri*
- ] [
- [ 2/ ] [ [ + ] change-nth-unsafe ] bi*
- ] if
- ] curry each-index
- ] keep ;
-
-: bytes>hex-string ( bytes -- hex-string )
- dup length 2 * CHAR: 0 <string> [
- [
- [ 16 /mod [ >digit ] bi@ ]
- [ 2 * dup 1 + ]
- [ [ set-nth-unsafe ] curry bi-curry@ bi* ] tri*
- ] curry each-index
- ] keep ;
! Copyright (C) 2023 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors arrays ascii assocs assocs.extras calendar
-calendar.format calendar.parser checksums checksums.hmac
-checksums.sha combinators combinators.short-circuit formatting
-http ini-file io.directories io.encodings.string
-io.encodings.utf8 io.files io.files.info io.launcher
-io.pathnames io.streams.string json kernel math math.order
-math.parser multiline prettyprint qw sequences
-sequences.generalizations sets sorting splitting strings urls
-urls.encoding ;
+USING: accessors arrays ascii assocs calendar calendar.format
+calendar.parser checksums checksums.hmac checksums.sha
+combinators combinators.short-circuit formatting hex-strings
+http ini-file io.directories io.encodings.utf8 io.files
+io.files.info io.pathnames io.streams.string json kernel math
+math.order sequences sets sorting splitting urls urls.encoding ;
IN: aws
: aws-timestamp-valid? ( str -- duration-valid valid? )
! Copyright (C) 2023 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors assocs assocs.extras checksums checksums.sha
-combinators formatting hashtables http http.client
+combinators formatting hashtables hex-strings http http.client
http.client.post-data io io.files io.pathnames json kernel make
-math.parser namespaces namespaces.extras sequences sorting urls ;
+namespaces namespaces.extras sequences sorting urls ;
IN: backblaze
SYMBOL: backblaze-application-key-id
-USING: base24 endian grouping kernel math.parser sequences
+USING: base24 endian grouping hex-strings kernel sequences
tools.test ;
IN: base24.tests
-USING: base58 math.parser strings tools.test ;
+USING: base58 hex-strings strings tools.test ;
{ "" } [ "" >base58 >string ] unit-test
{ "" } [ "" base58> >string ] unit-test
USING: benchmark.reverse-complement checksums checksums.md5
-io.files io.files.temp kernel math.parser tools.test ;
+hex-strings io.files io.files.temp kernel tools.test ;
{ "c071aa7e007a9770b2fb4304f55a17e5" } [
"resource:extra/benchmark/reverse-complement/reverse-complement-test-in.txt"
! Copyright (C) 2016 Alexander Ilin.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors ascii checksums checksums.common destructors io
-io.encodings.binary io.launcher kernel math.parser sequences ;
+USING: accessors ascii checksums checksums.common destructors
+hex-strings io io.encodings.binary io.launcher kernel sequences ;
IN: checksums.process
TUPLE: checksum-process launch-desc ;
! Copyright (C) 2013 John Benediktsson
! See https://factorcode.org/license.txt for BSD license
-USING: colors.private grouping kernel lexer math regexp.classes
+USING: colors.private grouping hex-strings kernel lexer math
sequences splitting ;
IN: colors.flex-hex
! Copyright (C) 2023 John Benediktsson
! See https://factorcode.org/license.txt for BSD license
-USING: byte-arrays combinators endian io kernel math
-math.bitwise math.order math.parser namespaces sequences strings
-;
+USING: byte-arrays combinators endian hex-strings io kernel math
+math.bitwise math.order namespaces sequences strings ;
IN: drunken-bishop
USING: accessors arrays assocs assocs.extras calendar
calendar.format checksums checksums.sha combinators
combinators.short-circuit combinators.smart compression.zlib
-constructors endian formatting grouping hashtables ini-file io
-io.directories io.encodings.binary io.encodings.string
-io.encodings.utf8 io.files io.files.info io.pathnames
-io.streams.byte-array io.streams.peek kernel math math.bitwise
-math.parser namespaces random sequences sequences.extras
-splitting splitting.monotonic strings ;
+constructors endian formatting grouping hashtables hex-strings
+ini-file io io.directories io.encodings.binary
+io.encodings.string io.encodings.utf8 io.files io.files.info
+io.pathnames io.streams.byte-array io.streams.peek kernel math
+math.bitwise math.parser namespaces random sequences
+sequences.extras splitting splitting.monotonic strings ;
IN: git
ERROR: byte-expected offset ;
: read-until* ( separators -- data )
dup read-until [ nip ] [ separator-expected ] if ;
-: find-git-directory ( path -- path' )
- [ ".git" tail? ] find-up-to-root ; inline
+ERROR: unknown-dot-git path ;
+
+: parse-dot-git-file ( path -- path' )
+ dup utf8 file-lines ?first "gitdir: " ?head [
+ nip
+ ] [
+ drop unknown-dot-git
+ ] if ;
+
+: find-git-directory ( path -- path'/f )
+ [ ".git" tail? ] find-up-to-root
+ dup ?file-info regular-file? [ parse-dot-git-file ] when ; inline
+
+: find-base-git-directory ( path -- path'/f )
+ find-git-directory dup ".git" tail? [ find-base-git-directory ] unless ;
ERROR: not-a-git-directory path ;
current-directory get not-a-git-directory
] unless* ;
+: current-git-base-directory ( -- path )
+ current-git-directory find-base-git-directory ;
+
: make-git-path ( str -- path )
current-git-directory prepend-path ;
+: make-git-base-path ( str -- path )
+ current-git-base-directory prepend-path ;
+
+: get-git-file-contents ( path -- contents )
+ make-git-base-path utf8 file-contents ;
+
+: get-git-file-lines ( path -- contents )
+ make-git-base-path utf8 file-lines ;
+
: make-refs-path ( str -- path )
[ "refs/" make-git-path ] dip append-path ;
ERROR: expected-ref got ;
+: git-hash? ( str -- ? ) sha1-string? ;
+
: parse-ref-line ( string -- string' )
- " " split1 [
- dup "ref:" = [ drop ] [ expected-ref ] if
- ] dip ;
+ "ref: " ?head [ expected-ref ] unless ;
+
+: parse-ref ( string -- string' )
+ dup git-hash? [ parse-ref-line ] unless ;
+
+: list-refs-for ( path -- seq )
+ "refs/" append-path recursive-directory-files ;
: list-refs ( -- seq )
- current-git-directory "refs/" append-path recursive-directory-files ;
+ current-git-base-directory list-refs-for ;
: remote-refs-dirs ( -- seq )
"remotes" make-refs-path directory-files ;
: ref-contents ( str -- line ) make-refs-path git-line ;
: git-stash-ref-sha1 ( -- contents ) "stash" ref-contents ;
-: git-ref ( ref -- sha1 ) git-line parse-ref-line ;
+: git-ref ( ref -- sha1 ) git-line parse-ref ;
: git-head-ref ( -- sha1 ) "HEAD" git-ref ;
-: git-log-for-ref ( ref -- log ) git-line git-read-object ;
+: git-log-for-ref ( ref -- log )
+ dup sha1-string? [ git-line ] unless git-read-object ;
: git-head-object ( -- commit ) git-head-ref git-log-for-ref ;
: git-config ( -- config ) "config" make-git-path ;
! See https://factorcode.org/license.txt for BSD license
USING: ascii assocs checksums checksums.md5 classes.tuple
-formatting http.client images.http io.encodings.string
-io.encodings.utf8 json kernel math.parser namespaces sequences
-urls ;
+formatting hex-strings http.client images.http
+io.encodings.string io.encodings.utf8 json kernel namespaces
+sequences urls ;
IN: gravatar
-USING: accessors arrays assocs calendar calendar.english
-calendar.format calendar.parser formatting grouping io io.crlf
-io.encodings.ascii io.encodings.binary io.encodings.string
-io.encodings.utf7 io.encodings.utf8 io.sockets io.sockets.secure
-io.streams.duplex io.streams.string kernel math math.parser
-multiline sequences sequences.extras splitting strings ;
+USING: accessors arrays ascii assocs base64 calendar
+calendar.english calendar.format calendar.parser combinators
+formatting grouping io io.crlf io.encodings.ascii
+io.encodings.binary io.encodings.string io.encodings.utf7
+io.encodings.utf8 io.sockets io.sockets.secure io.streams.duplex
+io.streams.string kernel math math.parser multiline sequences
+sequences.extras splitting splitting.monotonic strings ;
QUALIFIED: pcre
IN: imap
[ "UID SEARCH CHARSET UTF-8 %s" sprintf ] dip utf8 encode
command-response parse-items [ string>number ] map ;
+: search-imap-by-subject ( string -- uids ) [ "SUBJECT" ] dip search-mails ;
+: search-imap-by-body ( string -- uids ) [ "BODY" ] dip search-mails ;
+: search-imap-by-from ( string -- uids ) [ "FROM" ] dip search-mails ;
+
: fetch-mails ( uids data-spec -- texts )
[ comma-list ] dip "UID FETCH %s %s" sprintf "" command-response but-last ;
"" command-response
parse-store-mail ;
+TUPLE: parsed-email
+date to from subject cc
+return-path
+content-type
+content-transfer-encoding
+headers
+decoded-body ;
+
+: <parsed-email> ( -- obj )
+ parsed-email new
+ V{ } clone >>headers ; inline
+
+: decode-email-body ( parsed-email body -- parsed-email )
+ over content-transfer-encoding>> {
+ { "base64" [ base64> utf8 decode >>decoded-body ] }
+ [
+ ! "unsupported content-transfer-encoding" print
+ drop
+ >>decoded-body
+ ]
+ } case ;
+
+: parse-email-header ( parsed-email strings -- parsed-email )
+ [ nip ?first "\t\s" member? ] monotonic-split
+ [
+ [ [ blank? ] trim ] map " " join
+ ": " split1 swap >lower
+ ] { } map>assoc
+ [
+ [ pick headers>> push-at ]
+ [
+ {
+ { "date" [ >>date ] }
+ { "to" [ >>to ] }
+ { "from" [ >>from ] }
+ { "subject" [ >>subject ] }
+ { "return-path" [ >>return-path ] }
+ { "cc" [ >>to ] }
+ { "content-transfer-encoding" [ >>content-transfer-encoding ] }
+ { "content-type" [ >>content-type ] }
+ [ 2drop ]
+ } case
+ ] 2bi
+ ] assoc-each ;
+
+: parse-email ( string -- parsed-email )
+ [ <parsed-email> ] dip
+ "\r\n\r\n" split1
+ [ string-lines parse-email-header ] dip decode-email-body ;
+
! High level API
+: reject-uid-lines ( seq -- seq' ) [ "(UID" head? ] reject ;
+
+: fetch-rfc822-mails ( uids -- parsed-emails )
+ [ { } ] [ "(RFC822)" fetch-mails reject-uid-lines [ parse-email ] map ] if-empty ;
+
: with-imap ( host email password quot -- )
[ <imap4ssl> ] 3dip '[ _ _ login drop @ ] with-stream ; inline
--- /dev/null
+John Benediktsson
--- /dev/null
+USING: combinators.smart io io.encodings.utf8 io.files
+io.streams.tee kernel tools.test ;
+
+{ t } [
+ "resource:LICENSE.txt" utf8 [
+ [
+ utf8 [
+ tee-to-file-writer
+ [
+ readln
+ 42 read
+ " " read-until
+ read1
+ read-contents
+ ] output>array
+ ]
+ [
+ [
+ [
+ readln
+ 42 read
+ " " read-until
+ read1
+ read-contents
+ ] output>array
+ ] with-file-reader
+ ] 2bi =
+ ] with-test-file
+ ] with-file-reader
+] unit-test
--- /dev/null
+! Copyright (C) 2024 John Benediktsson
+! See https://factorcode.org/license.txt for BSD license
+
+USING: accessors destructors io io.files kernel math namespaces
+sequences ;
+
+IN: io.streams.tee
+
+TUPLE: tee-stream in out ;
+
+C: <tee-stream> tee-stream
+
+INSTANCE: tee-stream input-stream
+
+<PRIVATE
+
+: >tee-stream< ( tee-stream -- in out )
+ [ in>> ] [ out>> ] bi ; inline
+
+MACRO: tee1 ( read-quot write-quot -- quot )
+ '[ >tee-stream< _ [ [ over _ dip ] [ stream-flush ] bi ] bi* ] ;
+
+MACRO: tee2 ( read-quot write-quot -- quot )
+ '[ >tee-stream< _ [ [ 2over _ 2dip ] [ stream-flush ] bi ] bi* ] ;
+
+PRIVATE>
+
+M: tee-stream stream-element-type in>> stream-element-type ;
+
+M: tee-stream stream-read1
+ [ stream-read1 ] [ stream-write1 ] tee1 ;
+
+M:: tee-stream stream-read-unsafe ( n buf stream -- count )
+ n buf stream
+ [ stream-read-unsafe ]
+ [ '[ buf swap head _ stream-write ] unless-zero ] tee1 ;
+
+M:: tee-stream stream-read-partial-unsafe ( n buf stream -- count )
+ n buf stream
+ [ stream-read-partial-unsafe ]
+ [ '[ buf swap head _ stream-write ] unless-zero ] tee1 ;
+
+M: tee-stream stream-readln
+ [ stream-readln ]
+ [ '[ _ [ stream-write ] [ stream-nl ] bi ] when* ] tee1 ;
+
+M: tee-stream stream-read-until
+ >tee-stream<
+ [ stream-read-until ]
+ [
+ dup '[
+ [ [ _ stream-write ] when* ]
+ [ [ _ stream-write1 ] when* ] bi*
+ ] 2over [ call ] 2dip
+ ] bi* ;
+
+M: tee-stream stream-contents*
+ [ stream-contents* ] [ stream-write ] tee1 ;
+
+M: tee-stream dispose
+ >tee-stream< [ dispose ] bi@ ;
+
+: with-tee-stream ( input output quot -- )
+ [ <tee-stream> ] dip with-input-stream ; inline
+
+: tee-to-file-writer ( path encoding -- )
+ [ input-stream ] 2dip '[ _ _ <file-writer> <tee-stream> ] change ;
+
+: tee-to-file-appender ( path encoding -- )
+ [ input-stream ] 2dip '[ _ _ <file-appender> <tee-stream> ] change ;
+
+: tee-to-stdout ( -- )
+ input-stream [ output-stream get-global <tee-stream> ] change ;
+
+: tee-to-stderr ( -- )
+ input-stream [ error-stream get-global <tee-stream> ] change ;
! Copyright (C) 2014 Doug Coleman.
! See https://factorcode.org/license.txt for BSD license.
-USING: assocs checksums checksums.md5 http.client json kernel
-math.parser namespaces sequences strings system urls ;
+USING: assocs checksums checksums.md5 hex-strings http.client
+json kernel math.parser namespaces sequences strings system urls ;
IN: marvel
! https://developer.marvel.com/docs
Eduardo Cavazos
Slava Pestov
+nomennescio
build-child
[ notify-report ] [
status-clean eq?
- [ notify-upload upload-docs release ] when
+ [ notify-benchmarks notify-upload upload-docs release ] when
] bi
notify-finish
finish-build
IN: mason.git
: git-id ( -- id )
- { "git" "show" } process-lines
- first split-words second ;
+ { "git" "rev-parse" "HEAD" } process-lines first ;
<PRIVATE
[ name>> "report" status-notify ] [ email-report ] 2bi
] bi ;
+: notify-benchmarks ( -- )
+ "benchmark-results" utf8 file-contents f "benchmarks" status-notify ;
+
: notify-upload ( -- )
f f "upload" status-notify ;
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: assocs combinators.smart debugger formatting
+USING: arrays assocs combinators.smart debugger formatting
io.encodings.utf8 io.files io.streams.string kernel literals
-mason.common mason.config mason.disk math namespaces sequences
-splitting xml.syntax xml.writer ;
+mason.common mason.config mason.disk math namespaces prettyprint
+sequences sets splitting xml.syntax xml.writer ;
IN: mason.report
+: git-id>url ( id -- github-url )
+ "https://github.com/factor/factor/commit/" "" prepend-as ; inline
+
+: git-short-link ( id -- short-link )
+ [ git-id>url ] keep 8 head "…" append [XML <a href=<->><-></a> XML] ;
+
: git-link ( id -- link )
- [ "https://github.com/factor/factor/commit/" "" prepend-as ] keep
- [XML <a href=<->><-></a> XML] ;
+ [ git-id>url ] keep [XML <a href=<->><-></a> XML] ;
: common-report ( -- xml )
target-os get
] output>array sift
] with-report ;
+: benchmark-results ( -- assoc )
+ ${
+ boot-time-file
+ load-time-file
+ test-time-file
+ help-lint-time-file
+ benchmark-time-file
+ html-help-time-file
+ } [
+ dup eval-file 2array
+ ] map
+ benchmarks-file eval-file
+ union ;
+
+: successful-benchmarks ( -- )
+ "benchmark-results" utf8 [ benchmark-results ... ] with-file-writer ;
+
: build-clean? ( -- ? )
${
load-all-vocabs-file
} [ eval-file empty? ] all? ;
: success ( -- status )
- successful-report build-clean? status-clean status-dirty ? ;
+ successful-report build-clean? [ successful-benchmarks status-clean ] [ status-dirty ] if ;
USING: accessors arrays assocs byte-vectors checksums
-checksums.md5 constructors continuations destructors fry
-hashtables io.encodings.binary io.encodings.string
-io.encodings.utf8 io.sockets io.streams.duplex kernel locals
-math math.parser mongodb.cmd mongodb.msg strings
-namespaces sequences splitting ;
+checksums.md5 constructors continuations destructors hashtables
+hex-strings io.encodings.binary io.encodings.string
+io.encodings.utf8 io.sockets io.streams.duplex kernel math
+math.parser mongodb.cmd mongodb.msg namespaces sequences
+splitting strings ;
IN: mongodb.connection
: md5-checksum ( string -- digest )
"1999-01-12" "(?P<year>\\d{4})-(?P<month>\\d{2})-(?P<day>\\d{2})"
findall first
] unit-test
+
+{
+ {
+ { { f "h" } }
+ { { f "e" } }
+ { { f "l" } }
+ { { f "l" } }
+ { { f "o" } }
+ }
+} [ "hello" "(.)" findall ] unit-test
[ throw ]
} case
] [
- rc name_count 1 + assert=
match_data pcre2_get_ovector_pointer
rc assert-positive 2 * PCRE2_SIZE <c-direct-array> :> ovector
f
] [
- rc name_count 1 + assert=
[
f ovector first2 subject subseq 2array ,
name_table [
: load-scryfall-json ( type path -- uri )
[ find-scryfall-json "download_uri" of ] dip
- 10 days download-outdated-as path>json ;
+ 30 days download-outdated-as path>json ;
MEMO: mtg-oracle-cards ( -- json )
"oracle_cards" scryfall-oracle-json-path load-scryfall-json ;
: filter-card-faces-main-card-iprop ( seq string prop -- seq' )
swap >lower '[ _ of >lower _ subseq-of? ] filter-card-faces-main-card ;
+: filter-card-faces-main-card-iprop-member ( seq string prop -- seq' )
+ swap >lower '[ _ of [ >lower ] map _ member-of? ] filter-card-faces-main-card ;
+
: filter-by-flavor-text ( seq string -- seq' )
"flavor_text" filter-card-faces-main-card-prop ;
: filter-by-oracle-itext ( seq string -- seq' )
"oracle_text" filter-card-faces-main-card-iprop ;
+: filter-by-keyword ( seq string -- seq' )
+ "keywords" filter-card-faces-main-card-iprop-member ;
+
: filter-by-name-text ( seq string -- seq' ) "name" filter-by-text-prop ;
: filter-by-name-itext ( seq string -- seq' ) "name" filter-by-itext-prop ;
: filter-create-map-token ( seq -- seq' ) "create a map token" filter-by-oracle-itext ;
: filter-map-token ( seq -- seq' ) "map token" filter-by-oracle-itext ;
-: filter-affinity ( seq -- seq' ) "affinity" filter-by-oracle-itext ;
-: filter-backup ( seq -- seq' ) "backup" filter-by-oracle-itext ;
-: filter-blitz ( seq -- seq' ) "blitz" filter-by-oracle-itext ;
-: filter-compleated ( seq -- seq' ) "compleated" filter-by-oracle-itext ;
-: filter-corrupted ( seq -- seq' ) "corrupted" filter-by-oracle-itext ;
-: filter-counter ( seq -- seq' ) "counter" filter-by-oracle-itext ;
-: filter-crew ( seq -- seq' ) "crew" filter-by-oracle-itext ;
-: filter-cycling ( seq -- seq' ) "cycling" filter-by-oracle-itext ;
-: filter-deathtouch ( seq -- seq' ) "deathtouch" filter-by-oracle-itext ;
-: filter-defender ( seq -- seq' ) "defender" filter-by-oracle-itext ;
-: filter-descend ( seq -- seq' ) "descend" filter-by-oracle-itext ;
-: filter-destroy-target ( seq -- seq' ) "destroy target" filter-by-oracle-itext ;
-: filter-discover ( seq -- seq' ) "discover" filter-by-oracle-itext ;
-: filter-disguise ( seq -- seq' ) "disguise" filter-by-oracle-itext ;
-: filter-domain ( seq -- seq' ) "domain" filter-by-oracle-itext ;
-: filter-double-strike ( seq -- seq' ) "double strike" filter-by-oracle-itext ;
-: filter-equip ( seq -- seq' ) "equip" filter-by-oracle-itext ;
-: filter-equip-n ( seq -- seq' ) "equip {" filter-by-oracle-itext ;
-: filter-exile ( seq -- seq' ) "exile" filter-by-oracle-itext ;
-: filter-fights ( seq -- seq' ) "fights" filter-by-oracle-itext ;
-: filter-first-strike ( seq -- seq' ) "first strike" filter-by-oracle-itext ;
-: filter-flash ( seq -- seq' ) "flash" filter-by-oracle-itext ;
-: filter-flying ( seq -- seq' ) "flying" filter-by-oracle-itext ;
-: filter-for-mirrodin ( seq -- seq' ) "for mirrodin!" filter-by-oracle-itext ;
-: filter-graveyard ( seq -- seq' ) "graveyard" filter-by-oracle-itext ;
-: filter-haste ( seq -- seq' ) "haste" filter-by-oracle-itext ;
-: filter-hideaway ( seq -- seq' ) "hideaway" filter-by-oracle-itext ;
-: filter-hexproof ( seq -- seq' ) "hexproof" filter-by-oracle-itext ;
-: filter-indestructible ( seq -- seq' ) "indestructible" filter-by-oracle-itext ;
-: filter-investigate ( seq -- seq' ) "investigate" filter-by-oracle-itext ;
-: filter-lifelink ( seq -- seq' ) "lifelink" filter-by-oracle-itext ;
-: filter-madness ( seq -- seq' ) "madness" filter-by-oracle-itext ;
-: filter-menace ( seq -- seq' ) "menace" filter-by-oracle-itext ;
-: filter-mill ( seq -- seq' ) "mill" filter-by-oracle-itext ;
-: filter-ninjutsu ( seq -- seq' ) "ninjutsu" filter-by-oracle-itext ;
-: filter-proliferate ( seq -- seq' ) "proliferate" filter-by-oracle-itext ;
-: filter-protection ( seq -- seq' ) "protection" filter-by-oracle-itext ;
-: filter-prowess ( seq -- seq' ) "prowess" filter-by-oracle-itext ;
-: filter-reach ( seq -- seq' ) "reach" filter-by-oracle-itext ;
-: filter-read-ahead ( seq -- seq' ) "read ahead" filter-by-oracle-itext ;
-: filter-reconfigure ( seq -- seq' ) "reconfigure" filter-by-oracle-itext ;
-: filter-role ( seq -- seq' ) "role" filter-by-oracle-itext ;
-: filter-sacrifice ( seq -- seq' ) "sacrifice" filter-by-oracle-itext ;
-: filter-scry ( seq -- seq' ) "scry" filter-by-oracle-itext ;
-: filter-shroud ( seq -- seq' ) "shroud" filter-by-oracle-itext ;
-: filter-token ( seq -- seq' ) "token" filter-by-oracle-itext ;
-: filter-toxic ( seq -- seq' ) "toxic" filter-by-oracle-itext ;
-: filter-trample ( seq -- seq' ) "trample" filter-by-oracle-itext ;
-: filter-vehicle ( seq -- seq' ) "vehicle" filter-by-oracle-itext ;
-: filter-vigilance ( seq -- seq' ) "vigilance" filter-by-oracle-itext ;
-: filter-ward ( seq -- seq' ) "ward" filter-by-oracle-itext ;
+: filter-adamant-text ( seq -- seq' ) "adamant" filter-by-oracle-itext ;
+: filter-adapt-text ( seq -- seq' ) "adapt" filter-by-oracle-itext ;
+: filter-addendum-text ( seq -- seq' ) "addendum" filter-by-oracle-itext ;
+: filter-affinity-text ( seq -- seq' ) "affinity" filter-by-oracle-itext ;
+: filter-afflict-text ( seq -- seq' ) "afflict" filter-by-oracle-itext ;
+: filter-afterlife-text ( seq -- seq' ) "afterlife" filter-by-oracle-itext ;
+: filter-aftermath-text ( seq -- seq' ) "aftermath" filter-by-oracle-itext ;
+: filter-alliance-text ( seq -- seq' ) "alliance" filter-by-oracle-itext ;
+: filter-amass-text ( seq -- seq' ) "amass" filter-by-oracle-itext ;
+: filter-amplify-text ( seq -- seq' ) "amplify" filter-by-oracle-itext ;
+: filter-annihilator-text ( seq -- seq' ) "annihilator" filter-by-oracle-itext ;
+: filter-ascend-text ( seq -- seq' ) "ascend" filter-by-oracle-itext ;
+: filter-assemble-text ( seq -- seq' ) "assemble" filter-by-oracle-itext ;
+: filter-assist-text ( seq -- seq' ) "assist" filter-by-oracle-itext ;
+: filter-augment-text ( seq -- seq' ) "augment" filter-by-oracle-itext ;
+: filter-awaken-text ( seq -- seq' ) "awaken" filter-by-oracle-itext ;
+: filter-backup-text ( seq -- seq' ) "backup" filter-by-oracle-itext ;
+: filter-banding-text ( seq -- seq' ) "banding" filter-by-oracle-itext ;
+: filter-bargain-text ( seq -- seq' ) "bargain" filter-by-oracle-itext ;
+: filter-basic-landcycling-text ( seq -- seq' ) "basic landcycling" filter-by-oracle-itext ;
+: filter-battalion-text ( seq -- seq' ) "battalion" filter-by-oracle-itext ;
+: filter-battle-cry-text ( seq -- seq' ) "battle cry" filter-by-oracle-itext ;
+: filter-bestow-text ( seq -- seq' ) "bestow" filter-by-oracle-itext ;
+: filter-blitz-text ( seq -- seq' ) "blitz" filter-by-oracle-itext ;
+: filter-bloodrush-text ( seq -- seq' ) "bloodrush" filter-by-oracle-itext ;
+: filter-bloodthirst-text ( seq -- seq' ) "bloodthirst" filter-by-oracle-itext ;
+: filter-boast-text ( seq -- seq' ) "boast" filter-by-oracle-itext ;
+: filter-bolster-text ( seq -- seq' ) "bolster" filter-by-oracle-itext ;
+: filter-bushido-text ( seq -- seq' ) "bushido" filter-by-oracle-itext ;
+: filter-buyback-text ( seq -- seq' ) "buyback" filter-by-oracle-itext ;
+: filter-cascade-text ( seq -- seq' ) "cascade" filter-by-oracle-itext ;
+: filter-casualty-text ( seq -- seq' ) "casualty" filter-by-oracle-itext ;
+: filter-celebration-text ( seq -- seq' ) "celebration" filter-by-oracle-itext ;
+: filter-champion-text ( seq -- seq' ) "champion" filter-by-oracle-itext ;
+: filter-changeling-text ( seq -- seq' ) "changeling" filter-by-oracle-itext ;
+: filter-channel-text ( seq -- seq' ) "channel" filter-by-oracle-itext ;
+: filter-choose-a-background-text ( seq -- seq' ) "choose a background" filter-by-oracle-itext ;
+: filter-chroma-text ( seq -- seq' ) "chroma" filter-by-oracle-itext ;
+: filter-cipher-text ( seq -- seq' ) "cipher" filter-by-oracle-itext ;
+: filter-clash-text ( seq -- seq' ) "clash" filter-by-oracle-itext ;
+: filter-cleave-text ( seq -- seq' ) "cleave" filter-by-oracle-itext ;
+: filter-cloak-text ( seq -- seq' ) "cloak" filter-by-oracle-itext ;
+: filter-cohort-text ( seq -- seq' ) "cohort" filter-by-oracle-itext ;
+: filter-collect-evidence-text ( seq -- seq' ) "collect evidence" filter-by-oracle-itext ;
+: filter-companion-text ( seq -- seq' ) "companion" filter-by-oracle-itext ;
+: filter-compleated-text ( seq -- seq' ) "compleated" filter-by-oracle-itext ;
+: filter-conjure-text ( seq -- seq' ) "conjure" filter-by-oracle-itext ;
+: filter-connive-text ( seq -- seq' ) "connive" filter-by-oracle-itext ;
+: filter-conspire-text ( seq -- seq' ) "conspire" filter-by-oracle-itext ;
+: filter-constellation-text ( seq -- seq' ) "constellation" filter-by-oracle-itext ;
+: filter-converge-text ( seq -- seq' ) "converge" filter-by-oracle-itext ;
+: filter-convert-text ( seq -- seq' ) "convert" filter-by-oracle-itext ;
+: filter-convoke-text ( seq -- seq' ) "convoke" filter-by-oracle-itext ;
+: filter-corrupted-text ( seq -- seq' ) "corrupted" filter-by-oracle-itext ;
+: filter-council's-dilemma-text ( seq -- seq' ) "council's dilemma" filter-by-oracle-itext ;
+: filter-coven-text ( seq -- seq' ) "coven" filter-by-oracle-itext ;
+: filter-craft-text ( seq -- seq' ) "craft" filter-by-oracle-itext ;
+: filter-crew-text ( seq -- seq' ) "crew" filter-by-oracle-itext ;
+: filter-cumulative-upkeep-text ( seq -- seq' ) "cumulative upkeep" filter-by-oracle-itext ;
+: filter-cycling-text ( seq -- seq' ) "cycling" filter-by-oracle-itext ;
+: filter-dash-text ( seq -- seq' ) "dash" filter-by-oracle-itext ;
+: filter-daybound-text ( seq -- seq' ) "daybound" filter-by-oracle-itext ;
+: filter-deathtouch-text ( seq -- seq' ) "deathtouch" filter-by-oracle-itext ;
+: filter-defender-text ( seq -- seq' ) "defender" filter-by-oracle-itext ;
+: filter-delirium-text ( seq -- seq' ) "delirium" filter-by-oracle-itext ;
+: filter-delve-text ( seq -- seq' ) "delve" filter-by-oracle-itext ;
+: filter-descend-text ( seq -- seq' ) "descend" filter-by-oracle-itext ;
+: filter-detain-text ( seq -- seq' ) "detain" filter-by-oracle-itext ;
+: filter-dethrone-text ( seq -- seq' ) "dethrone" filter-by-oracle-itext ;
+: filter-devoid-text ( seq -- seq' ) "devoid" filter-by-oracle-itext ;
+: filter-devour-text ( seq -- seq' ) "devour" filter-by-oracle-itext ;
+: filter-discover-text ( seq -- seq' ) "discover" filter-by-oracle-itext ;
+: filter-disguise-text ( seq -- seq' ) "disguise" filter-by-oracle-itext ;
+: filter-disturb-text ( seq -- seq' ) "disturb" filter-by-oracle-itext ;
+: filter-doctor's-companion-text ( seq -- seq' ) "doctor's companion" filter-by-oracle-itext ;
+: filter-domain-text ( seq -- seq' ) "domain" filter-by-oracle-itext ;
+: filter-double-strike-text ( seq -- seq' ) "double strike" filter-by-oracle-itext ;
+: filter-dredge-text ( seq -- seq' ) "dredge" filter-by-oracle-itext ;
+: filter-echo-text ( seq -- seq' ) "echo" filter-by-oracle-itext ;
+: filter-embalm-text ( seq -- seq' ) "embalm" filter-by-oracle-itext ;
+: filter-emerge-text ( seq -- seq' ) "emerge" filter-by-oracle-itext ;
+: filter-eminence-text ( seq -- seq' ) "eminence" filter-by-oracle-itext ;
+: filter-enchant-text ( seq -- seq' ) "enchant" filter-by-oracle-itext ;
+: filter-encore-text ( seq -- seq' ) "encore" filter-by-oracle-itext ;
+: filter-enlist-text ( seq -- seq' ) "enlist" filter-by-oracle-itext ;
+: filter-enrage-text ( seq -- seq' ) "enrage" filter-by-oracle-itext ;
+: filter-entwine-text ( seq -- seq' ) "entwine" filter-by-oracle-itext ;
+: filter-equip-text ( seq -- seq' ) "equip" filter-by-oracle-itext ;
+: filter-escalate-text ( seq -- seq' ) "escalate" filter-by-oracle-itext ;
+: filter-escape-text ( seq -- seq' ) "escape" filter-by-oracle-itext ;
+: filter-eternalize-text ( seq -- seq' ) "eternalize" filter-by-oracle-itext ;
+: filter-evoke-text ( seq -- seq' ) "evoke" filter-by-oracle-itext ;
+: filter-evolve-text ( seq -- seq' ) "evolve" filter-by-oracle-itext ;
+: filter-exalted-text ( seq -- seq' ) "exalted" filter-by-oracle-itext ;
+: filter-exert-text ( seq -- seq' ) "exert" filter-by-oracle-itext ;
+: filter-exploit-text ( seq -- seq' ) "exploit" filter-by-oracle-itext ;
+: filter-explore-text ( seq -- seq' ) "explore" filter-by-oracle-itext ;
+: filter-extort-text ( seq -- seq' ) "extort" filter-by-oracle-itext ;
+: filter-fabricate-text ( seq -- seq' ) "fabricate" filter-by-oracle-itext ;
+: filter-fading-text ( seq -- seq' ) "fading" filter-by-oracle-itext ;
+: filter-fateful-hour-text ( seq -- seq' ) "fateful hour" filter-by-oracle-itext ;
+: filter-fathomless-descent-text ( seq -- seq' ) "fathomless descent" filter-by-oracle-itext ;
+: filter-fear-text ( seq -- seq' ) "fear" filter-by-oracle-itext ;
+: filter-ferocious-text ( seq -- seq' ) "ferocious" filter-by-oracle-itext ;
+: filter-fight-text ( seq -- seq' ) "fight" filter-by-oracle-itext ;
+: filter-first-strike-text ( seq -- seq' ) "first strike" filter-by-oracle-itext ;
+: filter-flanking-text ( seq -- seq' ) "flanking" filter-by-oracle-itext ;
+: filter-flash-text ( seq -- seq' ) "flash" filter-by-oracle-itext ;
+: filter-flashback-text ( seq -- seq' ) "flashback" filter-by-oracle-itext ;
+: filter-flying-text ( seq -- seq' ) "flying" filter-by-oracle-itext ;
+: filter-food-text ( seq -- seq' ) "food" filter-by-oracle-itext ;
+: filter-for-mirrodin!-text ( seq -- seq' ) "for mirrodin!" filter-by-oracle-itext ;
+: filter-forecast-text ( seq -- seq' ) "forecast" filter-by-oracle-itext ;
+: filter-forestcycling-text ( seq -- seq' ) "forestcycling" filter-by-oracle-itext ;
+: filter-forestwalk-text ( seq -- seq' ) "forestwalk" filter-by-oracle-itext ;
+: filter-foretell-text ( seq -- seq' ) "foretell" filter-by-oracle-itext ;
+: filter-formidable-text ( seq -- seq' ) "formidable" filter-by-oracle-itext ;
+: filter-friends-forever-text ( seq -- seq' ) "friends forever" filter-by-oracle-itext ;
+: filter-fuse-text ( seq -- seq' ) "fuse" filter-by-oracle-itext ;
+: filter-goad-text ( seq -- seq' ) "goad" filter-by-oracle-itext ;
+: filter-graft-text ( seq -- seq' ) "graft" filter-by-oracle-itext ;
+: filter-haste-text ( seq -- seq' ) "haste" filter-by-oracle-itext ;
+: filter-haunt-text ( seq -- seq' ) "haunt" filter-by-oracle-itext ;
+: filter-hellbent-text ( seq -- seq' ) "hellbent" filter-by-oracle-itext ;
+: filter-hero's-reward-text ( seq -- seq' ) "hero's reward" filter-by-oracle-itext ;
+: filter-heroic-text ( seq -- seq' ) "heroic" filter-by-oracle-itext ;
+: filter-hexproof-text ( seq -- seq' ) "hexproof" filter-by-oracle-itext ;
+: filter-hexproof-from-text ( seq -- seq' ) "hexproof from" filter-by-oracle-itext ;
+: filter-hidden-agenda-text ( seq -- seq' ) "hidden agenda" filter-by-oracle-itext ;
+: filter-hideaway-text ( seq -- seq' ) "hideaway" filter-by-oracle-itext ;
+: filter-horsemanship-text ( seq -- seq' ) "horsemanship" filter-by-oracle-itext ;
+: filter-imprint-text ( seq -- seq' ) "imprint" filter-by-oracle-itext ;
+: filter-improvise-text ( seq -- seq' ) "improvise" filter-by-oracle-itext ;
+: filter-incubate-text ( seq -- seq' ) "incubate" filter-by-oracle-itext ;
+: filter-indestructible-text ( seq -- seq' ) "indestructible" filter-by-oracle-itext ;
+: filter-infect-text ( seq -- seq' ) "infect" filter-by-oracle-itext ;
+: filter-ingest-text ( seq -- seq' ) "ingest" filter-by-oracle-itext ;
+: filter-inspired-text ( seq -- seq' ) "inspired" filter-by-oracle-itext ;
+: filter-intensity-text ( seq -- seq' ) "intensity" filter-by-oracle-itext ;
+: filter-intimidate-text ( seq -- seq' ) "intimidate" filter-by-oracle-itext ;
+: filter-investigate-text ( seq -- seq' ) "investigate" filter-by-oracle-itext ;
+: filter-islandcycling-text ( seq -- seq' ) "islandcycling" filter-by-oracle-itext ;
+: filter-islandwalk-text ( seq -- seq' ) "islandwalk" filter-by-oracle-itext ;
+: filter-jump-start-text ( seq -- seq' ) "jump-start" filter-by-oracle-itext ;
+: filter-kicker-text ( seq -- seq' ) "kicker" filter-by-oracle-itext ;
+: filter-kinship-text ( seq -- seq' ) "kinship" filter-by-oracle-itext ;
+: filter-landcycling-text ( seq -- seq' ) "landcycling" filter-by-oracle-itext ;
+: filter-landfall-text ( seq -- seq' ) "landfall" filter-by-oracle-itext ;
+: filter-landwalk-text ( seq -- seq' ) "landwalk" filter-by-oracle-itext ;
+: filter-learn-text ( seq -- seq' ) "learn" filter-by-oracle-itext ;
+: filter-level-up-text ( seq -- seq' ) "level up" filter-by-oracle-itext ;
+: filter-lieutenant-text ( seq -- seq' ) "lieutenant" filter-by-oracle-itext ;
+: filter-lifelink-text ( seq -- seq' ) "lifelink" filter-by-oracle-itext ;
+: filter-living-metal-text ( seq -- seq' ) "living metal" filter-by-oracle-itext ;
+: filter-living-weapon-text ( seq -- seq' ) "living weapon" filter-by-oracle-itext ;
+: filter-madness-text ( seq -- seq' ) "madness" filter-by-oracle-itext ;
+: filter-magecraft-text ( seq -- seq' ) "magecraft" filter-by-oracle-itext ;
+: filter-manifest-text ( seq -- seq' ) "manifest" filter-by-oracle-itext ;
+: filter-megamorph-text ( seq -- seq' ) "megamorph" filter-by-oracle-itext ;
+: filter-meld-text ( seq -- seq' ) "meld" filter-by-oracle-itext ;
+: filter-melee-text ( seq -- seq' ) "melee" filter-by-oracle-itext ;
+: filter-menace-text ( seq -- seq' ) "menace" filter-by-oracle-itext ;
+: filter-mentor-text ( seq -- seq' ) "mentor" filter-by-oracle-itext ;
+: filter-metalcraft-text ( seq -- seq' ) "metalcraft" filter-by-oracle-itext ;
+: filter-mill-text ( seq -- seq' ) "mill" filter-by-oracle-itext ;
+: filter-miracle-text ( seq -- seq' ) "miracle" filter-by-oracle-itext ;
+: filter-modular-text ( seq -- seq' ) "modular" filter-by-oracle-itext ;
+: filter-monstrosity-text ( seq -- seq' ) "monstrosity" filter-by-oracle-itext ;
+: filter-morbid-text ( seq -- seq' ) "morbid" filter-by-oracle-itext ;
+: filter-more-than-meets-the-eye-text ( seq -- seq' ) "more than meets the eye" filter-by-oracle-itext ;
+: filter-morph-text ( seq -- seq' ) "morph" filter-by-oracle-itext ;
+: filter-mountaincycling-text ( seq -- seq' ) "mountaincycling" filter-by-oracle-itext ;
+: filter-mountainwalk-text ( seq -- seq' ) "mountainwalk" filter-by-oracle-itext ;
+: filter-multikicker-text ( seq -- seq' ) "multikicker" filter-by-oracle-itext ;
+: filter-mutate-text ( seq -- seq' ) "mutate" filter-by-oracle-itext ;
+: filter-myriad-text ( seq -- seq' ) "myriad" filter-by-oracle-itext ;
+: filter-nightbound-text ( seq -- seq' ) "nightbound" filter-by-oracle-itext ;
+: filter-ninjutsu-text ( seq -- seq' ) "ninjutsu" filter-by-oracle-itext ;
+: filter-offering-text ( seq -- seq' ) "offering" filter-by-oracle-itext ;
+: filter-open-an-attraction-text ( seq -- seq' ) "open an attraction" filter-by-oracle-itext ;
+: filter-outlast-text ( seq -- seq' ) "outlast" filter-by-oracle-itext ;
+: filter-overload-text ( seq -- seq' ) "overload" filter-by-oracle-itext ;
+: filter-pack-tactics-text ( seq -- seq' ) "pack tactics" filter-by-oracle-itext ;
+: filter-paradox-text ( seq -- seq' ) "paradox" filter-by-oracle-itext ;
+: filter-parley-text ( seq -- seq' ) "parley" filter-by-oracle-itext ;
+: filter-partner-text ( seq -- seq' ) "partner" filter-by-oracle-itext ;
+: filter-partner-with-text ( seq -- seq' ) "partner with" filter-by-oracle-itext ;
+: filter-persist-text ( seq -- seq' ) "persist" filter-by-oracle-itext ;
+: filter-phasing-text ( seq -- seq' ) "phasing" filter-by-oracle-itext ;
+: filter-plainscycling-text ( seq -- seq' ) "plainscycling" filter-by-oracle-itext ;
+: filter-plot-text ( seq -- seq' ) "plot" filter-by-oracle-itext ;
+: filter-populate-text ( seq -- seq' ) "populate" filter-by-oracle-itext ;
+: filter-proliferate-text ( seq -- seq' ) "proliferate" filter-by-oracle-itext ;
+: filter-protection-text ( seq -- seq' ) "protection" filter-by-oracle-itext ;
+: filter-prototype-text ( seq -- seq' ) "prototype" filter-by-oracle-itext ;
+: filter-provoke-text ( seq -- seq' ) "provoke" filter-by-oracle-itext ;
+: filter-prowess-text ( seq -- seq' ) "prowess" filter-by-oracle-itext ;
+: filter-prowl-text ( seq -- seq' ) "prowl" filter-by-oracle-itext ;
+: filter-radiance-text ( seq -- seq' ) "radiance" filter-by-oracle-itext ;
+: filter-raid-text ( seq -- seq' ) "raid" filter-by-oracle-itext ;
+: filter-rally-text ( seq -- seq' ) "rally" filter-by-oracle-itext ;
+: filter-rampage-text ( seq -- seq' ) "rampage" filter-by-oracle-itext ;
+: filter-ravenous-text ( seq -- seq' ) "ravenous" filter-by-oracle-itext ;
+: filter-reach-text ( seq -- seq' ) "reach" filter-by-oracle-itext ;
+: filter-read-ahead-text ( seq -- seq' ) "read ahead" filter-by-oracle-itext ;
+: filter-rebound-text ( seq -- seq' ) "rebound" filter-by-oracle-itext ;
+: filter-reconfigure-text ( seq -- seq' ) "reconfigure" filter-by-oracle-itext ;
+: filter-recover-text ( seq -- seq' ) "recover" filter-by-oracle-itext ;
+: filter-reinforce-text ( seq -- seq' ) "reinforce" filter-by-oracle-itext ;
+: filter-renown-text ( seq -- seq' ) "renown" filter-by-oracle-itext ;
+: filter-replicate-text ( seq -- seq' ) "replicate" filter-by-oracle-itext ;
+: filter-retrace-text ( seq -- seq' ) "retrace" filter-by-oracle-itext ;
+: filter-revolt-text ( seq -- seq' ) "revolt" filter-by-oracle-itext ;
+: filter-riot-text ( seq -- seq' ) "riot" filter-by-oracle-itext ;
+: filter-role-token-text ( seq -- seq' ) "role token" filter-by-oracle-itext ;
+: filter-saddle-text ( seq -- seq' ) "saddle" filter-by-oracle-itext ;
+: filter-scavenge-text ( seq -- seq' ) "scavenge" filter-by-oracle-itext ;
+: filter-scry-text ( seq -- seq' ) "scry" filter-by-oracle-itext ;
+: filter-seek-text ( seq -- seq' ) "seek" filter-by-oracle-itext ;
+: filter-shadow-text ( seq -- seq' ) "shadow" filter-by-oracle-itext ;
+: filter-shroud-text ( seq -- seq' ) "shroud" filter-by-oracle-itext ;
+: filter-skulk-text ( seq -- seq' ) "skulk" filter-by-oracle-itext ;
+: filter-soulbond-text ( seq -- seq' ) "soulbond" filter-by-oracle-itext ;
+: filter-soulshift-text ( seq -- seq' ) "soulshift" filter-by-oracle-itext ;
+: filter-specialize-text ( seq -- seq' ) "specialize" filter-by-oracle-itext ;
+: filter-spectacle-text ( seq -- seq' ) "spectacle" filter-by-oracle-itext ;
+: filter-spell-mastery-text ( seq -- seq' ) "spell mastery" filter-by-oracle-itext ;
+: filter-splice-text ( seq -- seq' ) "splice" filter-by-oracle-itext ;
+: filter-split-second-text ( seq -- seq' ) "split second" filter-by-oracle-itext ;
+: filter-spree-text ( seq -- seq' ) "spree" filter-by-oracle-itext ;
+: filter-squad-text ( seq -- seq' ) "squad" filter-by-oracle-itext ;
+: filter-storm-text ( seq -- seq' ) "storm" filter-by-oracle-itext ;
+: filter-strive-text ( seq -- seq' ) "strive" filter-by-oracle-itext ;
+: filter-sunburst-text ( seq -- seq' ) "sunburst" filter-by-oracle-itext ;
+: filter-support-text ( seq -- seq' ) "support" filter-by-oracle-itext ;
+: filter-surge-text ( seq -- seq' ) "surge" filter-by-oracle-itext ;
+: filter-surveil-text ( seq -- seq' ) "surveil" filter-by-oracle-itext ;
+: filter-suspect-text ( seq -- seq' ) "suspect" filter-by-oracle-itext ;
+: filter-suspend-text ( seq -- seq' ) "suspend" filter-by-oracle-itext ;
+: filter-swampcycling-text ( seq -- seq' ) "swampcycling" filter-by-oracle-itext ;
+: filter-swampwalk-text ( seq -- seq' ) "swampwalk" filter-by-oracle-itext ;
+: filter-threshold-text ( seq -- seq' ) "threshold" filter-by-oracle-itext ;
+: filter-time-travel-text ( seq -- seq' ) "time travel" filter-by-oracle-itext ;
+: filter-totem-armor-text ( seq -- seq' ) "totem armor" filter-by-oracle-itext ;
+: filter-toxic-text ( seq -- seq' ) "toxic" filter-by-oracle-itext ;
+: filter-training-text ( seq -- seq' ) "training" filter-by-oracle-itext ;
+: filter-trample-text ( seq -- seq' ) "trample" filter-by-oracle-itext ;
+: filter-transform-text ( seq -- seq' ) "transform" filter-by-oracle-itext ;
+: filter-transmute-text ( seq -- seq' ) "transmute" filter-by-oracle-itext ;
+: filter-treasure-text ( seq -- seq' ) "treasure" filter-by-oracle-itext ;
+: filter-tribute-text ( seq -- seq' ) "tribute" filter-by-oracle-itext ;
+: filter-typecycling-text ( seq -- seq' ) "typecycling" filter-by-oracle-itext ;
+: filter-undergrowth-text ( seq -- seq' ) "undergrowth" filter-by-oracle-itext ;
+: filter-undying-text ( seq -- seq' ) "undying" filter-by-oracle-itext ;
+: filter-unearth-text ( seq -- seq' ) "unearth" filter-by-oracle-itext ;
+: filter-unleash-text ( seq -- seq' ) "unleash" filter-by-oracle-itext ;
+: filter-vanishing-text ( seq -- seq' ) "vanishing" filter-by-oracle-itext ;
+: filter-venture-into-the-dungeon-text ( seq -- seq' ) "venture into the dungeon" filter-by-oracle-itext ;
+: filter-vigilance-text ( seq -- seq' ) "vigilance" filter-by-oracle-itext ;
+: filter-ward-text ( seq -- seq' ) "ward" filter-by-oracle-itext ;
+: filter-will-of-the-council-text ( seq -- seq' ) "will of the council" filter-by-oracle-itext ;
+: filter-wither-text ( seq -- seq' ) "wither" filter-by-oracle-itext ;
: filter-day ( seq -- seq' ) "day" filter-by-oracle-itext ;
: filter-night ( seq -- seq' ) "night" filter-by-oracle-itext ;
: filter-saddle ( seq -- seq' ) "saddle" filter-by-oracle-itext ;
: filter-spree ( seq -- seq' ) "saddle" filter-by-oracle-itext ;
+: filter-adamant-keyword ( seq -- seq' ) "adamant" filter-by-keyword ;
+: filter-adapt-keyword ( seq -- seq' ) "adapt" filter-by-keyword ;
+: filter-addendum-keyword ( seq -- seq' ) "addendum" filter-by-keyword ;
+: filter-affinity-keyword ( seq -- seq' ) "affinity" filter-by-keyword ;
+: filter-afflict-keyword ( seq -- seq' ) "afflict" filter-by-keyword ;
+: filter-afterlife-keyword ( seq -- seq' ) "afterlife" filter-by-keyword ;
+: filter-aftermath-keyword ( seq -- seq' ) "aftermath" filter-by-keyword ;
+: filter-alliance-keyword ( seq -- seq' ) "alliance" filter-by-keyword ;
+: filter-amass-keyword ( seq -- seq' ) "amass" filter-by-keyword ;
+: filter-amplify-keyword ( seq -- seq' ) "amplify" filter-by-keyword ;
+: filter-annihilator-keyword ( seq -- seq' ) "annihilator" filter-by-keyword ;
+: filter-ascend-keyword ( seq -- seq' ) "ascend" filter-by-keyword ;
+: filter-assemble-keyword ( seq -- seq' ) "assemble" filter-by-keyword ;
+: filter-assist-keyword ( seq -- seq' ) "assist" filter-by-keyword ;
+: filter-augment-keyword ( seq -- seq' ) "augment" filter-by-keyword ;
+: filter-awaken-keyword ( seq -- seq' ) "awaken" filter-by-keyword ;
+: filter-backup-keyword ( seq -- seq' ) "backup" filter-by-keyword ;
+: filter-banding-keyword ( seq -- seq' ) "banding" filter-by-keyword ;
+: filter-bargain-keyword ( seq -- seq' ) "bargain" filter-by-keyword ;
+: filter-basic-landcycling-keyword ( seq -- seq' ) "basic-landcycling" filter-by-keyword ;
+: filter-battalion-keyword ( seq -- seq' ) "battalion" filter-by-keyword ;
+: filter-battle-cry-keyword ( seq -- seq' ) "battle-cry" filter-by-keyword ;
+: filter-bestow-keyword ( seq -- seq' ) "bestow" filter-by-keyword ;
+: filter-blitz-keyword ( seq -- seq' ) "blitz" filter-by-keyword ;
+: filter-bloodrush-keyword ( seq -- seq' ) "bloodrush" filter-by-keyword ;
+: filter-bloodthirst-keyword ( seq -- seq' ) "bloodthirst" filter-by-keyword ;
+: filter-boast-keyword ( seq -- seq' ) "boast" filter-by-keyword ;
+: filter-bolster-keyword ( seq -- seq' ) "bolster" filter-by-keyword ;
+: filter-bushido-keyword ( seq -- seq' ) "bushido" filter-by-keyword ;
+: filter-buyback-keyword ( seq -- seq' ) "buyback" filter-by-keyword ;
+: filter-cascade-keyword ( seq -- seq' ) "cascade" filter-by-keyword ;
+: filter-casualty-keyword ( seq -- seq' ) "casualty" filter-by-keyword ;
+: filter-celebration-keyword ( seq -- seq' ) "celebration" filter-by-keyword ;
+: filter-champion-keyword ( seq -- seq' ) "champion" filter-by-keyword ;
+: filter-changeling-keyword ( seq -- seq' ) "changeling" filter-by-keyword ;
+: filter-channel-keyword ( seq -- seq' ) "channel" filter-by-keyword ;
+: filter-choose-a-background-keyword ( seq -- seq' ) "choose-a-background" filter-by-keyword ;
+: filter-chroma-keyword ( seq -- seq' ) "chroma" filter-by-keyword ;
+: filter-cipher-keyword ( seq -- seq' ) "cipher" filter-by-keyword ;
+: filter-clash-keyword ( seq -- seq' ) "clash" filter-by-keyword ;
+: filter-cleave-keyword ( seq -- seq' ) "cleave" filter-by-keyword ;
+: filter-cloak-keyword ( seq -- seq' ) "cloak" filter-by-keyword ;
+: filter-cohort-keyword ( seq -- seq' ) "cohort" filter-by-keyword ;
+: filter-collect-evidence-keyword ( seq -- seq' ) "collect-evidence" filter-by-keyword ;
+: filter-companion-keyword ( seq -- seq' ) "companion" filter-by-keyword ;
+: filter-compleated-keyword ( seq -- seq' ) "compleated" filter-by-keyword ;
+: filter-conjure-keyword ( seq -- seq' ) "conjure" filter-by-keyword ;
+: filter-connive-keyword ( seq -- seq' ) "connive" filter-by-keyword ;
+: filter-conspire-keyword ( seq -- seq' ) "conspire" filter-by-keyword ;
+: filter-constellation-keyword ( seq -- seq' ) "constellation" filter-by-keyword ;
+: filter-converge-keyword ( seq -- seq' ) "converge" filter-by-keyword ;
+: filter-convert-keyword ( seq -- seq' ) "convert" filter-by-keyword ;
+: filter-convoke-keyword ( seq -- seq' ) "convoke" filter-by-keyword ;
+: filter-corrupted-keyword ( seq -- seq' ) "corrupted" filter-by-keyword ;
+: filter-council's-dilemma-keyword ( seq -- seq' ) "council's-dilemma" filter-by-keyword ;
+: filter-coven-keyword ( seq -- seq' ) "coven" filter-by-keyword ;
+: filter-craft-keyword ( seq -- seq' ) "craft" filter-by-keyword ;
+: filter-crew-keyword ( seq -- seq' ) "crew" filter-by-keyword ;
+: filter-cumulative-upkeep-keyword ( seq -- seq' ) "cumulative-upkeep" filter-by-keyword ;
+: filter-cycling-keyword ( seq -- seq' ) "cycling" filter-by-keyword ;
+: filter-dash-keyword ( seq -- seq' ) "dash" filter-by-keyword ;
+: filter-daybound-keyword ( seq -- seq' ) "daybound" filter-by-keyword ;
+: filter-deathtouch-keyword ( seq -- seq' ) "deathtouch" filter-by-keyword ;
+: filter-defender-keyword ( seq -- seq' ) "defender" filter-by-keyword ;
+: filter-delirium-keyword ( seq -- seq' ) "delirium" filter-by-keyword ;
+: filter-delve-keyword ( seq -- seq' ) "delve" filter-by-keyword ;
+: filter-descend-keyword ( seq -- seq' ) "descend" filter-by-keyword ;
+: filter-detain-keyword ( seq -- seq' ) "detain" filter-by-keyword ;
+: filter-dethrone-keyword ( seq -- seq' ) "dethrone" filter-by-keyword ;
+: filter-devoid-keyword ( seq -- seq' ) "devoid" filter-by-keyword ;
+: filter-devour-keyword ( seq -- seq' ) "devour" filter-by-keyword ;
+: filter-discover-keyword ( seq -- seq' ) "discover" filter-by-keyword ;
+: filter-disguise-keyword ( seq -- seq' ) "disguise" filter-by-keyword ;
+: filter-disturb-keyword ( seq -- seq' ) "disturb" filter-by-keyword ;
+: filter-doctor's-companion-keyword ( seq -- seq' ) "doctor's-companion" filter-by-keyword ;
+: filter-domain-keyword ( seq -- seq' ) "domain" filter-by-keyword ;
+: filter-double-strike-keyword ( seq -- seq' ) "double-strike" filter-by-keyword ;
+: filter-dredge-keyword ( seq -- seq' ) "dredge" filter-by-keyword ;
+: filter-echo-keyword ( seq -- seq' ) "echo" filter-by-keyword ;
+: filter-embalm-keyword ( seq -- seq' ) "embalm" filter-by-keyword ;
+: filter-emerge-keyword ( seq -- seq' ) "emerge" filter-by-keyword ;
+: filter-eminence-keyword ( seq -- seq' ) "eminence" filter-by-keyword ;
+: filter-enchant-keyword ( seq -- seq' ) "enchant" filter-by-keyword ;
+: filter-encore-keyword ( seq -- seq' ) "encore" filter-by-keyword ;
+: filter-enlist-keyword ( seq -- seq' ) "enlist" filter-by-keyword ;
+: filter-enrage-keyword ( seq -- seq' ) "enrage" filter-by-keyword ;
+: filter-entwine-keyword ( seq -- seq' ) "entwine" filter-by-keyword ;
+: filter-equip-keyword ( seq -- seq' ) "equip" filter-by-keyword ;
+: filter-escalate-keyword ( seq -- seq' ) "escalate" filter-by-keyword ;
+: filter-escape-keyword ( seq -- seq' ) "escape" filter-by-keyword ;
+: filter-eternalize-keyword ( seq -- seq' ) "eternalize" filter-by-keyword ;
+: filter-evoke-keyword ( seq -- seq' ) "evoke" filter-by-keyword ;
+: filter-evolve-keyword ( seq -- seq' ) "evolve" filter-by-keyword ;
+: filter-exalted-keyword ( seq -- seq' ) "exalted" filter-by-keyword ;
+: filter-exert-keyword ( seq -- seq' ) "exert" filter-by-keyword ;
+: filter-exploit-keyword ( seq -- seq' ) "exploit" filter-by-keyword ;
+: filter-explore-keyword ( seq -- seq' ) "explore" filter-by-keyword ;
+: filter-extort-keyword ( seq -- seq' ) "extort" filter-by-keyword ;
+: filter-fabricate-keyword ( seq -- seq' ) "fabricate" filter-by-keyword ;
+: filter-fading-keyword ( seq -- seq' ) "fading" filter-by-keyword ;
+: filter-fateful-hour-keyword ( seq -- seq' ) "fateful-hour" filter-by-keyword ;
+: filter-fathomless-descent-keyword ( seq -- seq' ) "fathomless-descent" filter-by-keyword ;
+: filter-fear-keyword ( seq -- seq' ) "fear" filter-by-keyword ;
+: filter-ferocious-keyword ( seq -- seq' ) "ferocious" filter-by-keyword ;
+: filter-fight-keyword ( seq -- seq' ) "fight" filter-by-keyword ;
+: filter-first-strike-keyword ( seq -- seq' ) "first-strike" filter-by-keyword ;
+: filter-flanking-keyword ( seq -- seq' ) "flanking" filter-by-keyword ;
+: filter-flash-keyword ( seq -- seq' ) "flash" filter-by-keyword ;
+: filter-flashback-keyword ( seq -- seq' ) "flashback" filter-by-keyword ;
+: filter-flying-keyword ( seq -- seq' ) "flying" filter-by-keyword ;
+: filter-food-keyword ( seq -- seq' ) "food" filter-by-keyword ;
+: filter-for-mirrodin!-keyword ( seq -- seq' ) "for-mirrodin!" filter-by-keyword ;
+: filter-forecast-keyword ( seq -- seq' ) "forecast" filter-by-keyword ;
+: filter-forestcycling-keyword ( seq -- seq' ) "forestcycling" filter-by-keyword ;
+: filter-forestwalk-keyword ( seq -- seq' ) "forestwalk" filter-by-keyword ;
+: filter-foretell-keyword ( seq -- seq' ) "foretell" filter-by-keyword ;
+: filter-formidable-keyword ( seq -- seq' ) "formidable" filter-by-keyword ;
+: filter-friends-forever-keyword ( seq -- seq' ) "friends-forever" filter-by-keyword ;
+: filter-fuse-keyword ( seq -- seq' ) "fuse" filter-by-keyword ;
+: filter-goad-keyword ( seq -- seq' ) "goad" filter-by-keyword ;
+: filter-graft-keyword ( seq -- seq' ) "graft" filter-by-keyword ;
+: filter-haste-keyword ( seq -- seq' ) "haste" filter-by-keyword ;
+: filter-haunt-keyword ( seq -- seq' ) "haunt" filter-by-keyword ;
+: filter-hellbent-keyword ( seq -- seq' ) "hellbent" filter-by-keyword ;
+: filter-hero's-reward-keyword ( seq -- seq' ) "hero's-reward" filter-by-keyword ;
+: filter-heroic-keyword ( seq -- seq' ) "heroic" filter-by-keyword ;
+: filter-hexproof-keyword ( seq -- seq' ) "hexproof" filter-by-keyword ;
+: filter-hexproof-from-keyword ( seq -- seq' ) "hexproof-from" filter-by-keyword ;
+: filter-hidden-agenda-keyword ( seq -- seq' ) "hidden-agenda" filter-by-keyword ;
+: filter-hideaway-keyword ( seq -- seq' ) "hideaway" filter-by-keyword ;
+: filter-horsemanship-keyword ( seq -- seq' ) "horsemanship" filter-by-keyword ;
+: filter-imprint-keyword ( seq -- seq' ) "imprint" filter-by-keyword ;
+: filter-improvise-keyword ( seq -- seq' ) "improvise" filter-by-keyword ;
+: filter-incubate-keyword ( seq -- seq' ) "incubate" filter-by-keyword ;
+: filter-indestructible-keyword ( seq -- seq' ) "indestructible" filter-by-keyword ;
+: filter-infect-keyword ( seq -- seq' ) "infect" filter-by-keyword ;
+: filter-ingest-keyword ( seq -- seq' ) "ingest" filter-by-keyword ;
+: filter-inspired-keyword ( seq -- seq' ) "inspired" filter-by-keyword ;
+: filter-intensity-keyword ( seq -- seq' ) "intensity" filter-by-keyword ;
+: filter-intimidate-keyword ( seq -- seq' ) "intimidate" filter-by-keyword ;
+: filter-investigate-keyword ( seq -- seq' ) "investigate" filter-by-keyword ;
+: filter-islandcycling-keyword ( seq -- seq' ) "islandcycling" filter-by-keyword ;
+: filter-islandwalk-keyword ( seq -- seq' ) "islandwalk" filter-by-keyword ;
+: filter-jump-start-keyword ( seq -- seq' ) "jump-start" filter-by-keyword ;
+: filter-kicker-keyword ( seq -- seq' ) "kicker" filter-by-keyword ;
+: filter-kinship-keyword ( seq -- seq' ) "kinship" filter-by-keyword ;
+: filter-landcycling-keyword ( seq -- seq' ) "landcycling" filter-by-keyword ;
+: filter-landfall-keyword ( seq -- seq' ) "landfall" filter-by-keyword ;
+: filter-landwalk-keyword ( seq -- seq' ) "landwalk" filter-by-keyword ;
+: filter-learn-keyword ( seq -- seq' ) "learn" filter-by-keyword ;
+: filter-level-up-keyword ( seq -- seq' ) "level-up" filter-by-keyword ;
+: filter-lieutenant-keyword ( seq -- seq' ) "lieutenant" filter-by-keyword ;
+: filter-lifelink-keyword ( seq -- seq' ) "lifelink" filter-by-keyword ;
+: filter-living-metal-keyword ( seq -- seq' ) "living-metal" filter-by-keyword ;
+: filter-living-weapon-keyword ( seq -- seq' ) "living-weapon" filter-by-keyword ;
+: filter-madness-keyword ( seq -- seq' ) "madness" filter-by-keyword ;
+: filter-magecraft-keyword ( seq -- seq' ) "magecraft" filter-by-keyword ;
+: filter-manifest-keyword ( seq -- seq' ) "manifest" filter-by-keyword ;
+: filter-megamorph-keyword ( seq -- seq' ) "megamorph" filter-by-keyword ;
+: filter-meld-keyword ( seq -- seq' ) "meld" filter-by-keyword ;
+: filter-melee-keyword ( seq -- seq' ) "melee" filter-by-keyword ;
+: filter-menace-keyword ( seq -- seq' ) "menace" filter-by-keyword ;
+: filter-mentor-keyword ( seq -- seq' ) "mentor" filter-by-keyword ;
+: filter-metalcraft-keyword ( seq -- seq' ) "metalcraft" filter-by-keyword ;
+: filter-mill-keyword ( seq -- seq' ) "mill" filter-by-keyword ;
+: filter-miracle-keyword ( seq -- seq' ) "miracle" filter-by-keyword ;
+: filter-modular-keyword ( seq -- seq' ) "modular" filter-by-keyword ;
+: filter-monstrosity-keyword ( seq -- seq' ) "monstrosity" filter-by-keyword ;
+: filter-morbid-keyword ( seq -- seq' ) "morbid" filter-by-keyword ;
+: filter-more-than-meets-the-eye-keyword ( seq -- seq' ) "more-than-meets-the-eye" filter-by-keyword ;
+: filter-morph-keyword ( seq -- seq' ) "morph" filter-by-keyword ;
+: filter-mountaincycling-keyword ( seq -- seq' ) "mountaincycling" filter-by-keyword ;
+: filter-mountainwalk-keyword ( seq -- seq' ) "mountainwalk" filter-by-keyword ;
+: filter-multikicker-keyword ( seq -- seq' ) "multikicker" filter-by-keyword ;
+: filter-mutate-keyword ( seq -- seq' ) "mutate" filter-by-keyword ;
+: filter-myriad-keyword ( seq -- seq' ) "myriad" filter-by-keyword ;
+: filter-nightbound-keyword ( seq -- seq' ) "nightbound" filter-by-keyword ;
+: filter-ninjutsu-keyword ( seq -- seq' ) "ninjutsu" filter-by-keyword ;
+: filter-offering-keyword ( seq -- seq' ) "offering" filter-by-keyword ;
+: filter-open-an-attraction-keyword ( seq -- seq' ) "open-an-attraction" filter-by-keyword ;
+: filter-outlast-keyword ( seq -- seq' ) "outlast" filter-by-keyword ;
+: filter-overload-keyword ( seq -- seq' ) "overload" filter-by-keyword ;
+: filter-pack-tactics-keyword ( seq -- seq' ) "pack-tactics" filter-by-keyword ;
+: filter-paradox-keyword ( seq -- seq' ) "paradox" filter-by-keyword ;
+: filter-parley-keyword ( seq -- seq' ) "parley" filter-by-keyword ;
+: filter-partner-keyword ( seq -- seq' ) "partner" filter-by-keyword ;
+: filter-partner-with-keyword ( seq -- seq' ) "partner-with" filter-by-keyword ;
+: filter-persist-keyword ( seq -- seq' ) "persist" filter-by-keyword ;
+: filter-phasing-keyword ( seq -- seq' ) "phasing" filter-by-keyword ;
+: filter-plainscycling-keyword ( seq -- seq' ) "plainscycling" filter-by-keyword ;
+: filter-plot-keyword ( seq -- seq' ) "plot" filter-by-keyword ;
+: filter-populate-keyword ( seq -- seq' ) "populate" filter-by-keyword ;
+: filter-proliferate-keyword ( seq -- seq' ) "proliferate" filter-by-keyword ;
+: filter-protection-keyword ( seq -- seq' ) "protection" filter-by-keyword ;
+: filter-prototype-keyword ( seq -- seq' ) "prototype" filter-by-keyword ;
+: filter-provoke-keyword ( seq -- seq' ) "provoke" filter-by-keyword ;
+: filter-prowess-keyword ( seq -- seq' ) "prowess" filter-by-keyword ;
+: filter-prowl-keyword ( seq -- seq' ) "prowl" filter-by-keyword ;
+: filter-radiance-keyword ( seq -- seq' ) "radiance" filter-by-keyword ;
+: filter-raid-keyword ( seq -- seq' ) "raid" filter-by-keyword ;
+: filter-rally-keyword ( seq -- seq' ) "rally" filter-by-keyword ;
+: filter-rampage-keyword ( seq -- seq' ) "rampage" filter-by-keyword ;
+: filter-ravenous-keyword ( seq -- seq' ) "ravenous" filter-by-keyword ;
+: filter-reach-keyword ( seq -- seq' ) "reach" filter-by-keyword ;
+: filter-read-ahead-keyword ( seq -- seq' ) "read-ahead" filter-by-keyword ;
+: filter-rebound-keyword ( seq -- seq' ) "rebound" filter-by-keyword ;
+: filter-reconfigure-keyword ( seq -- seq' ) "reconfigure" filter-by-keyword ;
+: filter-recover-keyword ( seq -- seq' ) "recover" filter-by-keyword ;
+: filter-reinforce-keyword ( seq -- seq' ) "reinforce" filter-by-keyword ;
+: filter-renown-keyword ( seq -- seq' ) "renown" filter-by-keyword ;
+: filter-replicate-keyword ( seq -- seq' ) "replicate" filter-by-keyword ;
+: filter-retrace-keyword ( seq -- seq' ) "retrace" filter-by-keyword ;
+: filter-revolt-keyword ( seq -- seq' ) "revolt" filter-by-keyword ;
+: filter-riot-keyword ( seq -- seq' ) "riot" filter-by-keyword ;
+: filter-role-token-keyword ( seq -- seq' ) "role-token" filter-by-keyword ;
+: filter-saddle-keyword ( seq -- seq' ) "saddle" filter-by-keyword ;
+: filter-scavenge-keyword ( seq -- seq' ) "scavenge" filter-by-keyword ;
+: filter-scry-keyword ( seq -- seq' ) "scry" filter-by-keyword ;
+: filter-seek-keyword ( seq -- seq' ) "seek" filter-by-keyword ;
+: filter-shadow-keyword ( seq -- seq' ) "shadow" filter-by-keyword ;
+: filter-shroud-keyword ( seq -- seq' ) "shroud" filter-by-keyword ;
+: filter-skulk-keyword ( seq -- seq' ) "skulk" filter-by-keyword ;
+: filter-soulbond-keyword ( seq -- seq' ) "soulbond" filter-by-keyword ;
+: filter-soulshift-keyword ( seq -- seq' ) "soulshift" filter-by-keyword ;
+: filter-specialize-keyword ( seq -- seq' ) "specialize" filter-by-keyword ;
+: filter-spectacle-keyword ( seq -- seq' ) "spectacle" filter-by-keyword ;
+: filter-spell-mastery-keyword ( seq -- seq' ) "spell-mastery" filter-by-keyword ;
+: filter-splice-keyword ( seq -- seq' ) "splice" filter-by-keyword ;
+: filter-split-second-keyword ( seq -- seq' ) "split-second" filter-by-keyword ;
+: filter-spree-keyword ( seq -- seq' ) "spree" filter-by-keyword ;
+: filter-squad-keyword ( seq -- seq' ) "squad" filter-by-keyword ;
+: filter-storm-keyword ( seq -- seq' ) "storm" filter-by-keyword ;
+: filter-strive-keyword ( seq -- seq' ) "strive" filter-by-keyword ;
+: filter-sunburst-keyword ( seq -- seq' ) "sunburst" filter-by-keyword ;
+: filter-support-keyword ( seq -- seq' ) "support" filter-by-keyword ;
+: filter-surge-keyword ( seq -- seq' ) "surge" filter-by-keyword ;
+: filter-surveil-keyword ( seq -- seq' ) "surveil" filter-by-keyword ;
+: filter-suspect-keyword ( seq -- seq' ) "suspect" filter-by-keyword ;
+: filter-suspend-keyword ( seq -- seq' ) "suspend" filter-by-keyword ;
+: filter-swampcycling-keyword ( seq -- seq' ) "swampcycling" filter-by-keyword ;
+: filter-swampwalk-keyword ( seq -- seq' ) "swampwalk" filter-by-keyword ;
+: filter-threshold-keyword ( seq -- seq' ) "threshold" filter-by-keyword ;
+: filter-time-travel-keyword ( seq -- seq' ) "time-travel" filter-by-keyword ;
+: filter-totem-armor-keyword ( seq -- seq' ) "totem-armor" filter-by-keyword ;
+: filter-toxic-keyword ( seq -- seq' ) "toxic" filter-by-keyword ;
+: filter-training-keyword ( seq -- seq' ) "training" filter-by-keyword ;
+: filter-trample-keyword ( seq -- seq' ) "trample" filter-by-keyword ;
+: filter-transform-keyword ( seq -- seq' ) "transform" filter-by-keyword ;
+: filter-transmute-keyword ( seq -- seq' ) "transmute" filter-by-keyword ;
+: filter-treasure-keyword ( seq -- seq' ) "treasure" filter-by-keyword ;
+: filter-tribute-keyword ( seq -- seq' ) "tribute" filter-by-keyword ;
+: filter-typecycling-keyword ( seq -- seq' ) "typecycling" filter-by-keyword ;
+: filter-undergrowth-keyword ( seq -- seq' ) "undergrowth" filter-by-keyword ;
+: filter-undying-keyword ( seq -- seq' ) "undying" filter-by-keyword ;
+: filter-unearth-keyword ( seq -- seq' ) "unearth" filter-by-keyword ;
+: filter-unleash-keyword ( seq -- seq' ) "unleash" filter-by-keyword ;
+: filter-vanishing-keyword ( seq -- seq' ) "vanishing" filter-by-keyword ;
+: filter-venture-into-the-dungeon-keyword ( seq -- seq' ) "venture-into-the-dungeon" filter-by-keyword ;
+: filter-vigilance-keyword ( seq -- seq' ) "vigilance" filter-by-keyword ;
+: filter-ward-keyword ( seq -- seq' ) "ward" filter-by-keyword ;
+: filter-will-of-the-council-keyword ( seq -- seq' ) "will-of-the-council" filter-by-keyword ;
+: filter-wither-keyword ( seq -- seq' ) "wither" filter-by-keyword ;
+
: power>n ( string -- n/f )
[ "*" = ] [ drop -1 ] [ string>number ] ?if ;
[
{
[ filter-instant ]
- [ filter-flash ]
- [ filter-cycling ]
- [ filter-disguise ]
- [ filter-madness ]
+ [ filter-flash-keyword ]
+ [ filter-cycling-keyword ]
+ [ filter-disguise-keyword ]
+ [ filter-madness-keyword ]
} cleave
] { } append-outputs-as sort-by-colors ;
] bi
<moxfield-deck> ;
+: moxfield-decks-for-username ( username -- json )
+ get-moxfield-user "data" of ;
+
: moxfield-random-deck-for-username ( username -- json )
- get-moxfield-user
- "data" of
+ moxfield-decks-for-username
random "publicId" of get-moxfield-deck
json>moxfield-deck ;
moxfield-latest-deck-for-username deck. ;
: moxfield-latest-deck-and-sideboard-for-username. ( username -- )
- moxfield-latest-deck-for-username deck-and-sideboard. ;
\ No newline at end of file
+ moxfield-latest-deck-for-username deck-and-sideboard. ;
--- /dev/null
+John Benediktsson
--- /dev/null
+USING: arrays sequences sequences.prefixed tools.test ;
+
+{ { 1 } } [ 1 f <prefixed> >array ] unit-test
+{ { 1 2 3 4 } } [ 1 { 2 3 4 } <prefixed> >array ] unit-test
--- /dev/null
+! Copyright (C) 2024 John Benediktsson
+! See https://factorcode.org/license.txt for BSD license
+USING: accessors kernel math math.order sequences sequences.private ;
+IN: sequences.prefixed
+
+TUPLE: prefixed
+{ elt object read-only }
+{ seq sequence read-only } ;
+
+C: <prefixed> prefixed
+
+M: prefixed length seq>> length 1 + ;
+
+M: prefixed nth-unsafe
+ over zero? [ nip elt>> ] [ [ 1 - ] [ seq>> ] bi* nth-unsafe ] if ;
+
+INSTANCE: prefixed immutable-sequence
+
--- /dev/null
+collections
+sequences
--- /dev/null
+John Benediktsson
--- /dev/null
+USING: arrays sequences sequences.suffixed tools.test ;
+
+{ { 1 } } [ f 1 <suffixed> >array ] unit-test
+{ { 1 2 3 4 } } [ { 1 2 3 } 4 <suffixed> >array ] unit-test
--- /dev/null
+! Copyright (C) 2024 John Benediktsson
+! See https://factorcode.org/license.txt for BSD license
+USING: accessors kernel math math.order sequences sequences.private ;
+IN: sequences.suffixed
+
+TUPLE: suffixed
+{ seq sequence read-only }
+{ elt object read-only } ;
+
+C: <suffixed> suffixed
+
+M: suffixed length seq>> length 1 + ;
+
+M: suffixed nth-unsafe
+ [ seq>> 2dup bounds-check? ] keep swap
+ [ drop nth-unsafe ] [ 2nip elt>> ] if ;
+
+INSTANCE: suffixed immutable-sequence
+
--- /dev/null
+collections
+sequences
! See https://factorcode.org/license.txt for BSD license
USING: accessors assocs base64 calendar calendar.format
-checksums.hmac checksums.sha combinators.smart formatting http
-http.client json kernel make math.parser namespaces random
+checksums.hmac checksums.sha combinators.smart formatting
+hex-strings http http.client json kernel make namespaces random
sequences splitting ;
IN: visionect
Slava Pestov
+nomennescio
{ "status" "STATUS" TEXT }
} define-persistent
+TUPLE: run
+run-id timestamp host-name os cpu git-id ;
+
+run "RUNS" {
+ { "run-id" "RUN_ID" INTEGER +db-assigned-id+ }
+ { "timestamp" "TIMESTAMP" TIMESTAMP }
+ { "host-name" "HOST_NAME" TEXT }
+ { "os" "OS" TEXT }
+ { "cpu" "CPU" TEXT }
+ { "git-id" "GIT_ID" TEXT }
+} define-persistent
+
+TUPLE: benchmark
+run-id name duration ;
+
+benchmark "BENCHMARKS" {
+ { "run-id" "RUN_ID" INTEGER +user-assigned-id+ }
+ { "name" "NAME" TEXT +user-assigned-id+ }
+ { "duration" "DURATION_NANOSECONDS" UNSIGNED-BIG-INTEGER }
+} define-persistent
+
TUPLE: counter id value ;
counter "COUNTER" {
mason-db [ with-transaction ] with-db ; inline
: init-mason-db ( -- )
- { builder counter } ensure-tables ;
+ { builder counter run benchmark } ensure-tables ;
--- /dev/null
+nomennescio
--- /dev/null
+! Copyright (C) 2024 nomennescio.
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar calendar.format combinators
+db.tuples formatting furnace.actions html.forms
+http.server.responses io io.streams.string kernel math.parser
+sequences webapps.mason.backend webapps.mason.utils ;
+IN: webapps.mason.benchmarks
+
+: benchmark-results ( -- response )
+ [ selected-benchmarks ] with-mason-db
+ [
+ "run,timestamp (UTC),host,os,cpu,git,name,duration (ns)" print
+ '[
+ [ run-id>> ] [ name>> ] [ duration>> ] tri
+ [ _ at { [ run-id>> ] [ timestamp>> timestamp>iso8601Z ] [ host-name>> ] [ os>> ] [ cpu>> ] [ git-id>> ] } cleave ] 2dip
+ "%s,%s,%s,%s,%s,%s,%s,%s\n" printf
+ ] each
+ ] with-string-writer <text-content> ;
+
+: <benchmark-results-action> ( -- action )
+ <action>
+ [ validate-benchmark-selection ] >>init
+ [ benchmark-results ] >>display ;
<t:style t:include="resource:extra/webapps/mason/mason.css" />
<div style="padding: 10px;">
<h1>Build machines</h1>
+ <t:xml t:name="machines" />
+
+ <h1>Build targets</h1>
<t:xml t:name="builders" />
<h1>Force build now</h1>
! Copyright (C) 2010 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel furnace.actions html.forms
-sequences sorting xml.syntax webapps.mason.backend
-webapps.mason.utils ;
+USING: accessors arrays calendar.format combinators
+combinators.extras furnace.actions grouping.extras html.forms
+kernel mason.report math.order sequences sorting
+sorting.specification webapps.mason.backend webapps.mason.utils
+xml.syntax ;
IN: webapps.mason.downloads
CONSTANT: OFFLINE
[ drop f ]
} cond ;
+: machine-list ( builders -- xml )
+ { { host-name>> <=> } { os>> <=> } { cpu>> <=> } } sort-with-spec
+ [ host-name>> ] group-by
+ [
+ first2
+ [
+ [ os/cpu ] [ current-git-id>> git-short-link ] [ status>> ] tri
+ [XML <tr><td></td><td><-></td><td><-></td><td><-></td></tr> XML]
+ ] map
+ [XML <tr><td><i><-></i></td></tr><-> XML]
+ ] map
+ [ [XML <p>No machines.</p> XML] ]
+ [ [XML <table><tr>
+ <th align="left">Machine</th>
+ <th align="left">Target</th>
+ <th align="left">Git</th>
+ <th align="left">Status</th>
+ </tr>
+ <tr><td></td><td></td><td></td><td><i>starting/make-vm/boot/test/upload/finish/idle</i></td></tr>
+ <-></table> XML] ]
+ if-empty ;
+
: builder-list ( seq -- xml )
[ os/cpu ] sort-by
[
- [ report-url ] [ os/cpu ] [ builder-status ] tri
- [XML <li><a href=<->><-></a> <-></li> XML]
+ [ os/cpu ] [ report-url ] [ current-timestamp>> timestamp>ymdhms ] [ builder-status ] quad
+ [XML <tr><td><-></td><td><a href=<->><-></a></td><td><-></td></tr> XML]
] map
[ [XML <p>No machines.</p> XML] ]
- [ [XML <ul><-></ul> XML] ]
+ [ [XML <table><tr>
+ <th align="left">Target</th>
+ <th align="left">Build report</th>
+ <th align="left">Build status</th>
+ </tr><-></table> XML] ]
if-empty ;
: <dashboard-action> ( -- action )
<page-action>
[
[
- all-builders builder-list
- "builders" set-value
+ all-builders
+ [ machine-list "machines" set-value ]
+ [ builder-list "builders" set-value ] bi
] with-mason-db
] >>init ;
USING: accessors furnace.actions furnace.auth furnace.db
furnace.redirection http.server.dispatchers urls
webapps.mason.backend webapps.mason.grids webapps.mason.package
-webapps.mason.release webapps.mason.report
+webapps.mason.release webapps.mason.report webapps.mason.benchmarks
webapps.mason.downloads webapps.mason.counter
webapps.mason.status-update webapps.mason.docs-update
webapps.mason.dashboard webapps.mason.make-release
<build-report-action>
"report" add-responder
+ <benchmark-results-action>
+ "benchmark-results" add-responder
+
<download-package-action>
{ mason-app "download-package" } >>template
"package" add-responder
! Copyright (C) 2010 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors calendar combinators db.tuples furnace.actions
-furnace.redirection html.forms http.server.responses io kernel
-namespaces validators webapps.mason.utils webapps.mason.backend ;
+USING: accessors assocs calendar combinators db.tuples
+furnace.actions furnace.redirection html.forms
+http.server.responses io kernel multiline namespaces parser
+prettyprint sequences splitting validators webapps.mason.backend
+webapps.mason.utils ;
IN: webapps.mason.status-update
: find-builder ( host-name os cpu -- builder )
swap >>host-name
[ select-tuple ] [ dup insert-tuple ] ?unless ;
+: update-runs ( builder -- run-id )
+ [ run new ] dip
+ { [ host-name>> >>host-name ]
+ [ os>> >>os ]
+ [ cpu>> >>cpu ]
+ [ current-timestamp>> >>timestamp ]
+ [ current-git-id>> >>git-id ] } cleave
+ dup insert-tuple run-id>> ;
+
+: update-benchmarks ( run-id benchmarks -- )
+ [ benchmark new swap >>run-id ] dip
+ [ first2 [ >>name ] dip >>duration insert-tuple ] with each ;
+
: heartbeat ( builder -- )
now >>heartbeat-timestamp
drop ;
: test ( builder -- ) +test+ status ;
+: benchmarks ( builder content -- )
+ [ update-runs ] dip
+ split-lines parse-fresh first update-benchmarks ;
+
: report ( builder content status -- )
[
>>last-report
{ "boot" [ boot ] }
{ "test" [ test ] }
{ "report" [ "report" value "arg" value report ] }
+ { "benchmarks" [ "report" value benchmarks ] }
{ "upload" [ upload ] }
{ "finish" [ finish ] }
{ "release" [ "arg" value release ] }
! Copyright (C) 2010 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs db.tuples furnace.actions
-furnace.utilities html.forms kernel mason.config namespaces
+USING: accessors arrays assocs calendar calendar.format
+db.tuples furnace.actions furnace.utilities html.forms
+io.streams.string kernel mason.config math.parser namespaces
sequences urls validators webapps.mason.backend
webapps.mason.version.data xml.syntax ;
IN: webapps.mason.utils
: link ( url label -- xml )
[XML <a href=<->><-></a> XML] ;
+: timestamp>iso8601Z ( timestamp -- string )
+ [ >utc { YYYY MM DD "T" hhmm ss "Z" } formatted ] with-string-writer ;
+
: validate-os/cpu ( -- )
{
{ "os" [ v-one-line ] }
{ "cpu" [ v-one-line ] }
} validate-params ;
+: validate-benchmark-selection ( -- )
+ {
+ { "host" [ [ v-one-line ] v-optional ] }
+ { "os" [ [ v-one-line ] v-optional ] }
+ { "cpu" [ [ v-one-line ] v-optional ] }
+ { "git" [ [ v-one-line ] v-optional ] }
+ { "run" [ [ v-one-line ] v-optional ] }
+ ! { "timestamp" [ [ v-one-line ] v-optional ] } ! parsing of ISO8601 is currently not supported
+ { "name" [ [ v-one-line ] v-optional ] }
+ } validate-params ;
+
+: selected-runs ( -- runs )
+ run new
+ "run" value dec> >>run-id
+ ! "timestamp" value >>timestamp ! parsing of ISO8601 is currently not supported
+ "host" value >>host-name
+ "os" value >>os
+ "cpu" value >>cpu
+ "git" value >>git-id
+ select-tuples ;
+
+: selected-benchmarks ( -- benchmarks runs )
+ selected-runs [ [ run-id>> ] keep ] map>alist
+ [
+ keys [ V{ } clone benchmark new "name" value >>name ] dip
+ [ >>run-id select-tuples append! ] with each
+ ] keep ;
+
: current-builder ( -- builder/f )
builder new "os" value >>os "cpu" value >>cpu select-tuple ;
! See https://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs bootstrap.image calendar cli.git
combinators combinators.short-circuit concurrency.combinators
-environment formatting http.download io io.directories
-io.launcher io.pathnames kernel math.parser memory modern.paths
-namespaces parser.notes prettyprint regexp.classes sequences
-sequences.extras sets splitting system system-info threads
-tools.test tools.test.private vocabs vocabs.hierarchy
+environment formatting hex-strings http.download io
+io.directories io.launcher io.pathnames kernel math.parser
+memory modern.paths namespaces parser.notes prettyprint
+sequences sequences.extras sets splitting system system-info
+threads tools.test tools.test.private vocabs vocabs.hierarchy
vocabs.hierarchy.private vocabs.loader vocabs.metadata zealot ;
IN: zealot.factor
! See https://factorcode.org/license.txt for BSD license
USING: accessors combinators command-line destructors formatting
-io io.directories io.encodings io.encodings.binary io.files
-kernel math math.parser namespaces sequences uuid zim ;
+hex-strings io io.directories io.encodings io.encodings.binary
+io.files kernel math namespaces sequences uuid zim ;
IN: zim.tools
include vm/Config.unix
-PLAF_DLL_OBJS += vm/os-genunix.o vm/os-freebsd.o vm/mvm-unix.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/os-genunix.o $(BUILD_DIR)/os-freebsd.o $(BUILD_DIR)/mvm-unix.o
PLAF_MASTER_HEADERS += vm/os-genunix.hpp vm/os-freebsd.hpp
LIBS = -L/usr/local/lib -lm $(X11_UI_LIBS) -pthread -lc -Wl,--export-dynamic -lthr -lpango-1.0 -lpangocairo-1.0 -lcairo -lglib-2.0 -lgobject-2.0 -lgtk-x11-2.0 -lgdk-x11-2.0 -lgdk_pixbuf-2.0 -lgtkglext-x11-1.0 -latk-1.0 -lgio-2.0 -lgdkglext-x11-1.0 -lGL
include vm/Config.unix
-PLAF_DLL_OBJS += vm/os-genunix.o vm/os-linux.o vm/mvm-unix.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/os-genunix.o $(BUILD_DIR)/os-linux.o $(BUILD_DIR)/mvm-unix.o
PLAF_MASTER_HEADERS += vm/os-genunix.hpp vm/os-linux.hpp
LIBS = -ldl -lm -lrt -lpthread -Wl,--export-dynamic
include vm/Config.linux
include vm/Config.arm
-PLAF_DLL_OBJS += vm/os-linux-arm.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/os-linux-arm.o
PLAF_MASTER_HEADERS += vm/os-linux-arm.hpp
include vm/Config.linux
include vm/Config.arm
-PLAF_DLL_OBJS += vm/cpu-arm.32.o
-PLAF_MASTER_HEADERS += vm/cpu-arm.32.hpp
\ No newline at end of file
+PLAF_DLL_OBJS += $(BUILD_DIR)/cpu-arm.32.o
+PLAF_MASTER_HEADERS += $(BUILD_DIR)/cpu-arm.32.hpp
\ No newline at end of file
include vm/Config.linux
include vm/Config.arm
-PLAF_DLL_OBJS += vm/cpu-arm.64.o
-PLAF_MASTER_HEADERS += vm/cpu-arm.64.hpp
\ No newline at end of file
+PLAF_DLL_OBJS += $(BUILD_DIR)/cpu-arm.64.o
+PLAF_MASTER_HEADERS += $(BUILD_DIR)/cpu-arm.64.hpp
\ No newline at end of file
include vm/Config.linux
-PLAF_DLL_OBJS += vm/cpu-ppc.linux.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/cpu-ppc.linux.o
SITE_CFLAGS += -m32
include vm/Config.linux
-PLAF_DLL_OBJS += vm/cpu-ppc.linux.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/cpu-ppc.linux.o
SITE_CFLAGS += -m64
include vm/Config.unix
-PLAF_DLL_OBJS += vm/os-macosx.o vm/mach_signal.o vm/mvm-unix.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/os-macosx.o $(BUILD_DIR)/mach_signal.o $(BUILD_DIR)/mvm-unix.o
PLAF_MASTER_HEADERS += vm/os-macosx.hpp vm/mach_signal.hpp
DLL_EXTENSION = .dylib
LIBS = -lm -framework Cocoa -framework AppKit
endif
-LINKER = $(CXX) $(CFLAGS) $(CXXFLAGS) $(SHARED_FLAG) -single_module \
+LINKER = $(CXX) $(CFLAGS) $(CXXFLAGS) $(SHARED_FLAG) \
-current_version $(VERSION) \
-compatibility_version $(VERSION) \
-fvisibility=hidden \
SHARED_DLL_EXTENSION = .so
SHARED_FLAG = -shared
-PLAF_DLL_OBJS += vm/os-unix.o
-PLAF_EXE_OBJS += vm/main-unix.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/os-unix.o
+PLAF_EXE_OBJS += $(BUILD_DIR)/main-unix.o
PLAF_MASTER_HEADERS += vm/os-unix.hpp vm/atomic-gcc.hpp vm/atomic.hpp
FFI_TEST_CFLAGS = -fPIC
LIBS = -lm
-PLAF_DLL_OBJS += vm/os-windows.o vm/mvm-windows.o
-PLAF_EXE_OBJS += vm/resources.o vm/main-windows.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/os-windows.o $(BUILD_DIR)/mvm-windows.o
+PLAF_EXE_OBJS += $(BUILD_DIR)/resources.o $(BUILD_DIR)/main-windows.o
PLAF_MASTER_HEADERS += vm/os-windows.hpp
EXE_SUFFIX=
-PLAF_DLL_OBJS += vm/os-windows-x86.32.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/os-windows-x86.32.o
PLAF_MASTER_HEADERS += vm/os-windows.32.hpp vm/atomic-cl-32.hpp vm/atomic.hpp
DLL_PATH=http://factorcode.org/dlls/32
WINDRES=windres -F pe-i386
-PLAF_DLL_OBJS += vm/os-windows-x86.64.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/os-windows-x86.64.o
PLAF_MASTER_HEADERS += vm/os-windows.64.hpp vm/atomic-cl-64.hpp vm/atomic.hpp
DLL_PATH=http://factorcode.org/dlls/64
CC=$(WIN64_PATH)-gcc.exe
-PLAF_DLL_OBJS += vm/cpu-x86.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/cpu-x86.o
PLAF_MASTER_HEADERS += vm/cpu-x86.hpp
SITE_CFLAGS += -m32
-PLAF_DLL_OBJS += vm/cpu-x86.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/cpu-x86.o
PLAF_MASTER_HEADERS += vm/cpu-x86.hpp
SITE_CFLAGS += -m64
-PLAF_DLL_OBJS += vm/cpu-x86.o
+PLAF_DLL_OBJS += $(BUILD_DIR)/cpu-x86.o
PLAF_MASTER_HEADERS += vm/cpu-x86.hpp
bignum** quotient, bignum** remainder) {
if (BIGNUM_ZERO_P(denominator)) {
divide_by_zero_error();
+ (*quotient) = denominator;
+ (*remainder) = denominator;
return;
}
if (BIGNUM_ZERO_P(numerator)) {
namespace factor {
-#define CALLSTACK_BOTTOM(ctx) (ctx->callstack_seg->end - sizeof(cell) * 5) // omg
+#define CALLSTACK_BOTTOM(ctx) (ctx->callstack_seg->end - sizeof(cell) * 6) // omg
// void c_to_factor(cell quot);
// void lazy_jit_compile(cell quot);
case RC_RELATIVE_ARM64_BCOND:
return load_value_masked(rel_relative_arm64_bcond_mask, 3, 11, 0) +
relative_to;
+ case RC_ABSOLUTE_ARM64_MOVZ:
+ return load_value_masked(rel_absolute_arm64_movz_mask, 5, 16, 0);
+ case RC_RELATIVE_CELL:
+ return *(cell*)(pointer - sizeof(cell));
default:
critical_error("Bad rel class", rel.klass());
return 0;
case RC_RELATIVE_ARM64_BCOND:
store_value_masked(relative_value, rel_relative_arm64_bcond_mask, 2, 5);
break;
+ case RC_ABSOLUTE_ARM64_MOVZ:
+ store_value_masked(absolute_value, rel_absolute_arm64_movz_mask, 0, 5);
+ break;
+ case RC_RELATIVE_CELL:
+ *(cell*)(pointer - sizeof(cell)) = relative_value;
+ break;
default:
critical_error("Bad rel class", rel.klass());
break;
RC_ABSOLUTE_1,
// absolute address in a PowerPC LIS/ORI/SLDI/ORIS/ORI sequence
RC_ABSOLUTE_PPC_2_2_2_2,
- // relative address in an ARM64 B/BL instruction
+ // Relative address stored, divided by four, in bits 25:0 of an ARM64 instruction
RC_RELATIVE_ARM64_BRANCH,
- // relative address in an ARM64 B.cond instruction
+ // Relative address stored, divided by four, in bits 23:5 of an ARM64 instruction
RC_RELATIVE_ARM64_BCOND,
+ // Absolute address stored in bits 20:5 of an ARM64 instruction
+ RC_ABSOLUTE_ARM64_MOVZ,
+ // relative address in a pointer-width location
+ RC_RELATIVE_CELL,
};
static const cell rel_absolute_ppc_2_mask = 0x0000ffff;
static const cell rel_relative_arm_3_mask = 0x00ffffff;
static const cell rel_relative_arm64_branch_mask = 0x03ffffff;
static const cell rel_relative_arm64_bcond_mask = 0x00ffffe0;
+static const cell rel_absolute_arm64_movz_mask = 0x001fffe0;
// code relocation table consists of a table of entries for each fixup
struct relocation_entry {
namespace factor {
#define CALLSTACK_BOTTOM(ctx) \
- (ctx->callstack_seg->end - sizeof(cell) * 5)
+ (ctx->callstack_seg->end - sizeof(cell) * 6)
static const fixnum xt_tail_pic_offset = 4 + 1;
namespace factor {
void flush_icache(cell start, cell len) {
- int result;
+// int result;
- // XXX: why doesn't this work on Nokia n800? It should behave
- // identically to the below assembly.
- // result = syscall(__ARM_NR_cacheflush,start,start + len,0);
+// // XXX: why doesn't this work on Nokia n800? It should behave
+// // identically to the below assembly.
+// // result = syscall(__ARM_NR_cacheflush,start,start + len,0);
- // Assembly swiped from
- // http://lists.arm.linux.org.uk/pipermail/linux-arm/2002-July/003931.html
- __asm__ __volatile__("mov r0, %1\n"
- "sub r1, %2, #1\n"
- "mov r2, #0\n"
- "swi " __sys1(__ARM_NR_cacheflush) "\n"
- "mov %0, r0\n"
- : "=r"(result)
- : "r"(start), "r"(start + len)
- : "r0", "r1", "r2");
+// // Assembly swiped from
+// // http://lists.arm.linux.org.uk/pipermail/linux-arm/2002-July/003931.html
+// __asm__ __volatile__("mov r0, %1\n"
+// "sub r1, %2, #1\n"
+// "mov r2, #0\n"
+// "swi " __sys1(__ARM_NR_cacheflush) "\n"
+// "mov %0, r0\n"
+// : "=r"(result)
+// : "r"(start), "r"(start + len)
+// : "r0", "r1", "r2");
- if (result < 0)
- critical_error("flush_icache() failed", result);
+// if (result < 0)
+// critical_error("flush_icache() failed", result);
}
}
projects / factor.git / commitdiff