Clean up whitespace
- Tabs to spaces - Remove invisible whitespace at ends of lines - Break or shorten long lines (not for all files)
This commit is contained in:
parent
09c6368668
commit
be9b2b364e
26
LICENSE
26
LICENSE
|
|
@ -7,20 +7,20 @@ modification, are permitted provided that the following conditions are met:
|
|||
|
||||
* Redistributions of source code must retain the above copyright notice,
|
||||
this list of conditions and the following disclaimer.
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
* Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
* Neither the author nor the names of any contributors may be used to
|
||||
endorse or promote products derived from this software without specific
|
||||
prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
|
||||
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
|
||||
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
||||
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
#include "flisp.h"
|
||||
#include "equalhash.h"
|
||||
|
||||
#include "htable.inc"
|
||||
#include "htable_inc.h"
|
||||
|
||||
#define _equal_lispvalue_(x, y) equal_lispvalue((value_t)(x), (value_t)(y))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef EQUALHASH_H
|
||||
#define EQUALHASH_H
|
||||
|
||||
#include "htableh.inc"
|
||||
#include "htableh_inc.h"
|
||||
|
||||
HTPROT(equalhash)
|
||||
|
||||
|
|
|
|||
42
c/lookup3.c
42
c/lookup3.c
|
|
@ -1,5 +1,5 @@
|
|||
/*
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
lookup3.c, by Bob Jenkins, May 2006, Public Domain.
|
||||
|
||||
These are functions for producing 32-bit hashes for hash table lookup.
|
||||
|
|
@ -31,7 +31,7 @@ Why is this so big? I read 12 bytes at a time into 3 4-byte integers,
|
|||
then mix those integers. This is fast (you can do a lot more thorough
|
||||
mixing with 12*3 instructions on 3 integers than you can with 3 instructions
|
||||
on 1 byte), but shoehorning those bytes into integers efficiently is messy.
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
*/
|
||||
//#define SELF_TEST 1
|
||||
|
||||
|
|
@ -74,7 +74,7 @@ typedef unsigned short uint16_t;
|
|||
#define rot(x, k) (((x) << (k)) | ((x) >> (32 - (k))))
|
||||
|
||||
/*
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
mix -- mix 3 32-bit values reversibly.
|
||||
|
||||
This is reversible, so any information in (a,b,c) before mix() is
|
||||
|
|
@ -115,7 +115,7 @@ direction as the goal of parallelism. I did what I could. Rotates
|
|||
seem to cost as much as shifts on every machine I could lay my hands
|
||||
on, and rotates are much kinder to the top and bottom bits, so I used
|
||||
rotates.
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
*/
|
||||
#define mix(a, b, c) \
|
||||
{ \
|
||||
|
|
@ -140,7 +140,7 @@ rotates.
|
|||
}
|
||||
|
||||
/*
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
final -- final mixing of 3 32-bit values (a,b,c) into c
|
||||
|
||||
Pairs of (a,b,c) values differing in only a few bits will usually
|
||||
|
|
@ -162,7 +162,7 @@ and these came close:
|
|||
4 8 15 26 3 22 24
|
||||
10 8 15 26 3 22 24
|
||||
11 8 15 26 3 22 24
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
*/
|
||||
#define final(a, b, c) \
|
||||
{ \
|
||||
|
|
@ -183,7 +183,7 @@ and these came close:
|
|||
}
|
||||
|
||||
/*
|
||||
--------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
This works on all machines. To be useful, it requires
|
||||
-- that the key be an array of uint32_t's, and
|
||||
-- that the length be the number of uint32_t's in the key
|
||||
|
|
@ -193,7 +193,7 @@ and these came close:
|
|||
except that the length has to be measured in uint32_ts rather than in
|
||||
bytes. hashlittle() is more complicated than hashword() only because
|
||||
hashlittle() has to dance around fitting the key bytes into registers.
|
||||
--------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
*/
|
||||
uint32_t
|
||||
hashword(const uint32_t *k, /* the key, an array of uint32_t values */
|
||||
|
|
@ -287,7 +287,7 @@ void hashword2(const uint32_t *k, /* the key, an array of uint32_t values */
|
|||
|
||||
#if 0
|
||||
/*
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
hashlittle() -- hash a variable-length key into a 32-bit value
|
||||
k : the key (the unaligned variable-length array of bytes)
|
||||
length : the length of the key, counting by bytes
|
||||
|
|
@ -310,7 +310,7 @@ code any way you wish, private, educational, or commercial. It's free.
|
|||
|
||||
Use for hash table lookup, or anything where one collision in 2^^32 is
|
||||
acceptable. Do NOT use for cryptographic purposes.
|
||||
-------------------------------------------------------------------------------
|
||||
------------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
uint32_t hashlittle( const void *key, size_t length, uint32_t initval)
|
||||
|
|
@ -326,7 +326,7 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval)
|
|||
const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */
|
||||
const uint8_t *k8;
|
||||
|
||||
/*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */
|
||||
/*----- all but last block: aligned reads and affect 32 bits of (a,b,c) */
|
||||
while (length > 12)
|
||||
{
|
||||
a += k[0];
|
||||
|
|
@ -337,7 +337,7 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval)
|
|||
k += 3;
|
||||
}
|
||||
|
||||
/*----------------------------- handle the last (probably partial) block */
|
||||
/*---------------------------- handle the last (probably partial) block */
|
||||
/*
|
||||
* "k[2]&0xffffff" actually reads beyond the end of the string, but
|
||||
* then masks off the part it's not allowed to read. Because the
|
||||
|
|
@ -392,7 +392,7 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval)
|
|||
const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */
|
||||
const uint8_t *k8;
|
||||
|
||||
/*--------------- all but last block: aligned reads and different mixing */
|
||||
/*-------------- all but last block: aligned reads and different mixing */
|
||||
while (length > 12)
|
||||
{
|
||||
a += k[0] + (((uint32_t)k[1])<<16);
|
||||
|
|
@ -403,7 +403,7 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval)
|
|||
k += 6;
|
||||
}
|
||||
|
||||
/*----------------------------- handle the last (probably partial) block */
|
||||
/*---------------------------- handle the last (probably partial) block */
|
||||
k8 = (const uint8_t *)k;
|
||||
switch(length)
|
||||
{
|
||||
|
|
@ -438,7 +438,7 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval)
|
|||
} else { /* need to read the key one byte at a time */
|
||||
const uint8_t *k = (const uint8_t *)key;
|
||||
|
||||
/*--------------- all but the last block: affect some 32 bits of (a,b,c) */
|
||||
/*-------------- all but the last block: affect some 32 bits of (a,b,c) */
|
||||
while (length > 12)
|
||||
{
|
||||
a += k[0];
|
||||
|
|
@ -458,7 +458,7 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval)
|
|||
k += 12;
|
||||
}
|
||||
|
||||
/*-------------------------------- last block: affect all 32 bits of (c) */
|
||||
/*------------------------------- last block: affect all 32 bits of (c) */
|
||||
switch(length) /* all the case statements fall through */
|
||||
{
|
||||
case 12: c+=((uint32_t)k[11])<<24;
|
||||
|
|
@ -772,7 +772,7 @@ uint32_t *pb) /* IN: secondary initval, OUT: secondary hash */
|
|||
uint32_t hashbig( const void *key, size_t length, uint32_t initval)
|
||||
{
|
||||
uint32_t a,b,c;
|
||||
union { const void *ptr; size_t i; } u; /* to cast key to (size_t) happily */
|
||||
union { const void *ptr; size_t i; } u; /* to cast key to size_t happily */
|
||||
|
||||
/* Set up the internal state */
|
||||
a = b = c = 0xdeadbeef + ((uint32_t)length) + initval;
|
||||
|
|
@ -782,7 +782,7 @@ uint32_t hashbig( const void *key, size_t length, uint32_t initval)
|
|||
const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */
|
||||
const uint8_t *k8;
|
||||
|
||||
/*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */
|
||||
/*----- all but last block: aligned reads and affect 32 bits of (a,b,c) */
|
||||
while (length > 12)
|
||||
{
|
||||
a += k[0];
|
||||
|
|
@ -793,7 +793,7 @@ uint32_t hashbig( const void *key, size_t length, uint32_t initval)
|
|||
k += 3;
|
||||
}
|
||||
|
||||
/*----------------------------- handle the last (probably partial) block */
|
||||
/*---------------------------- handle the last (probably partial) block */
|
||||
/*
|
||||
* "k[2]<<8" actually reads beyond the end of the string, but
|
||||
* then shifts out the part it's not allowed to read. Because the
|
||||
|
|
@ -847,7 +847,7 @@ uint32_t hashbig( const void *key, size_t length, uint32_t initval)
|
|||
} else { /* need to read the key one byte at a time */
|
||||
const uint8_t *k = (const uint8_t *)key;
|
||||
|
||||
/*--------------- all but the last block: affect some 32 bits of (a,b,c) */
|
||||
/*-------------- all but the last block: affect some 32 bits of (a,b,c) */
|
||||
while (length > 12)
|
||||
{
|
||||
a += ((uint32_t)k[0])<<24;
|
||||
|
|
@ -867,7 +867,7 @@ uint32_t hashbig( const void *key, size_t length, uint32_t initval)
|
|||
k += 12;
|
||||
}
|
||||
|
||||
/*-------------------------------- last block: affect all 32 bits of (c) */
|
||||
/*------------------------------- last block: affect all 32 bits of (c) */
|
||||
switch(length) /* all the case statements fall through */
|
||||
{
|
||||
case 12: c+=k[11];
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
(*banner* "; _\n; |_ _ _ |_ _ | . _ _\n; | (-||||_(_)|__|_)|_)\n;-------------------|----------------------------------------------------------\n\n"
|
||||
(*banner* "; _\n; |_ _ _ |_ _ | . _ _\n; | (-||||_(_)|__|_)|_)\n;-------------------|--\n\n"
|
||||
*builtins* [0 0 0 0 0 0 0 0 0 0 0 0 #fn("7000r2|}<;" [])
|
||||
#fn("7000r2|}=;" [])
|
||||
#fn("7000r2|}>;" [])
|
||||
|
|
@ -64,7 +64,7 @@
|
|||
with-bindings *output-stream* #fn(copy-list)]) catch #fn("7000r2c0qc13041;" [#fn("@000r1c0\x7fc1|L1c2c3c4|L2c5c6|L2c7c8L2L3c5c9|L2~L3L4c:|L2c;|L2L4L3L3;" [trycatch
|
||||
lambda if and pair? eq car quote thrown-value cadr caddr raise])
|
||||
#fn(gensym)]))
|
||||
*whitespace* "\t\n\v\f\r \u0085 \u2028\u2029 " 1+
|
||||
*whitespace* "\t\n\v\f\r \u0085 \u180e
" 1+
|
||||
#fn("7000r1|aw;" [] 1+) 1- #fn("7000r1|ax;" [] 1-) 1arg-lambda?
|
||||
#fn("8000r1|F16T02|Mc0<16J02|NF16B02|\x84F16:02e1|\x84a42;" [lambda
|
||||
length=] 1arg-lambda?)
|
||||
|
|
|
|||
|
|
@ -244,10 +244,13 @@
|
|||
|
||||
(define (compile-sym g env s Is)
|
||||
(let ((loc (lookup-sym s env 0 #t)))
|
||||
(cond ((number? loc) (emit g (aref Is 0) loc))
|
||||
((number? (car loc)) (emit g (aref Is 1) (car loc) (cdr loc))
|
||||
; update index of most distant captured frame
|
||||
(bcode:cdepth g (- (nnn (cdr env)) 1 (car loc))))
|
||||
(cond ((number? loc)
|
||||
(emit g (aref Is 0) loc))
|
||||
((number? (car loc))
|
||||
(emit g (aref Is 1) (car loc) (cdr loc))
|
||||
;; update index of most distant captured frame
|
||||
(bcode:cdepth
|
||||
g (- (nnn (cdr env)) 1 (car loc))))
|
||||
(else
|
||||
(if (and (constant? s)
|
||||
(printable? (top-level-value s)))
|
||||
|
|
@ -479,7 +482,8 @@
|
|||
(expand-define x)))
|
||||
(trycatch (compile-in g env #f `(lambda () ,(cadr x)))
|
||||
(unless (1arg-lambda? (caddr x))
|
||||
(error "trycatch: second form must be a 1-argument lambda"))
|
||||
(error
|
||||
"trycatch: second form must be a 1-argument lambda"))
|
||||
(compile-in g env #f (caddr x))
|
||||
(emit g 'trycatch))
|
||||
(else (compile-app g env tail? x))))))
|
||||
|
|
|
|||
|
|
@ -113,7 +113,7 @@
|
|||
(cond-clauses->if (cdr lst)))))))))
|
||||
(cond-clauses->if clauses))
|
||||
|
||||
; standard procedures ---------------------------------------------------------
|
||||
; standard procedures --------------------------------------------------------
|
||||
|
||||
(define (member item lst)
|
||||
(cond ((atom? lst) #f)
|
||||
|
|
@ -213,7 +213,7 @@
|
|||
(apply consumer (cdr res))
|
||||
(consumer res))))))
|
||||
|
||||
; list utilities --------------------------------------------------------------
|
||||
; list utilities -------------------------------------------------------------
|
||||
|
||||
(define (every pred lst)
|
||||
(or (atom? lst)
|
||||
|
|
@ -362,7 +362,7 @@
|
|||
(cons elt
|
||||
(delete-duplicates tail)))))))
|
||||
|
||||
; backquote -------------------------------------------------------------------
|
||||
; backquote ------------------------------------------------------------------
|
||||
|
||||
(define (revappend l1 l2) (reverse- l2 l1))
|
||||
(define (nreconc l1 l2) (reverse!- l2 l1))
|
||||
|
|
@ -453,7 +453,7 @@
|
|||
;; (... . x)
|
||||
(cons 'nconc (reverse! (cons (bq-process p d) q)))))))))
|
||||
|
||||
; standard macros -------------------------------------------------------------
|
||||
; standard macros ------------------------------------------------------------
|
||||
|
||||
(define (quote-value v)
|
||||
(if (self-evaluating? v)
|
||||
|
|
@ -554,7 +554,7 @@
|
|||
(begin ,@body)
|
||||
(begin ,@(map (lambda (v old) `(set! ,v ,old)) vars olds))))))
|
||||
|
||||
; exceptions ------------------------------------------------------------------
|
||||
; exceptions -----------------------------------------------------------------
|
||||
|
||||
(define (error . args) (raise (cons 'error args)))
|
||||
|
||||
|
|
@ -576,7 +576,7 @@
|
|||
(lambda (,e) (begin (,thk) (raise ,e))))
|
||||
(,thk)))))
|
||||
|
||||
; debugging utilities ---------------------------------------------------------
|
||||
; debugging utilities --------------------------------------------------------
|
||||
|
||||
(define-macro (assert expr) `(if ,expr #t (raise '(assert-failed ,expr))))
|
||||
|
||||
|
|
@ -614,7 +614,7 @@
|
|||
,expr
|
||||
(princ "Elapsed time: " (- (time.now) ,t0) " seconds\n")))))
|
||||
|
||||
; text I/O --------------------------------------------------------------------
|
||||
; text I/O -------------------------------------------------------------------
|
||||
|
||||
(define (print . args) (for-each write args))
|
||||
(define (princ . args)
|
||||
|
|
@ -653,7 +653,7 @@
|
|||
`(with-bindings ((*input-stream* ,stream))
|
||||
,@body))
|
||||
|
||||
; vector functions ------------------------------------------------------------
|
||||
; vector functions -----------------------------------------------------------
|
||||
|
||||
(define (list->vector l) (apply vector l))
|
||||
(define (vector->list v)
|
||||
|
|
@ -672,7 +672,7 @@
|
|||
(aset! nv i (f (aref v i)))))
|
||||
nv))
|
||||
|
||||
; table functions -------------------------------------------------------------
|
||||
; table functions ------------------------------------------------------------
|
||||
|
||||
(define (table.pairs t)
|
||||
(table.foldl (lambda (k v z) (cons (cons k v) z))
|
||||
|
|
@ -696,7 +696,7 @@
|
|||
(define (table.foreach f t)
|
||||
(table.foldl (lambda (k v z) (begin (f k v) #t)) () t))
|
||||
|
||||
; string functions ------------------------------------------------------------
|
||||
; string functions -----------------------------------------------------------
|
||||
|
||||
(define (string.tail s n) (string.sub s (string.inc s 0 n)))
|
||||
|
||||
|
|
@ -756,7 +756,7 @@
|
|||
(cdr strlist))
|
||||
(io.tostring! b))))
|
||||
|
||||
; toplevel --------------------------------------------------------------------
|
||||
; toplevel -------------------------------------------------------------------
|
||||
|
||||
(define (macrocall? e) (and (symbol? (car e))
|
||||
(symbol-syntax (car e))))
|
||||
|
|
@ -919,7 +919,7 @@
|
|||
; _
|
||||
; |_ _ _ |_ _ | . _ _
|
||||
; | (-||||_(_)|__|_)|_)
|
||||
;-------------------|----------------------------------------------------------
|
||||
;-------------------|--
|
||||
|
||||
" 1))
|
||||
|
||||
|
|
|
|||
|
|
@ -284,7 +284,8 @@ todo:
|
|||
|
||||
* handle dotted arglists in lambda
|
||||
|
||||
- optimize constant functions, e.g. (funcall/cc-0 #:g65 (lambda (#:g58) 'done))
|
||||
- optimize constant functions, e.g.
|
||||
(funcall/cc-0 #:g65 (lambda (#:g58) 'done))
|
||||
|
||||
- implement CPS version of apply
|
||||
|
||||
|
|
|
|||
|
|
@ -4292,4 +4292,3 @@
|
|||
((set! var val) (syntax exp2))
|
||||
((id x (... ...)) (syntax (exp1 x (... ...))))
|
||||
(id (identifier? (syntax id)) (syntax exp1))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -41,13 +41,15 @@
|
|||
(f t zero)
|
||||
(f t (foldl t (lambda (e state) (foldtree-post f e state)) zero))))
|
||||
|
||||
; general tree transformer
|
||||
; folds in preorder (foldtree-pre), maps in postorder (maptree-post)
|
||||
; therefore state changes occur immediately, just by looking at the current node,
|
||||
; while transformation follows evaluation order. this seems to be the most natural
|
||||
; approach.
|
||||
; (mapper tree state) - should return transformed tree given current state
|
||||
; (folder tree state) - should return new state
|
||||
;; general tree transformer
|
||||
;;
|
||||
;; Folds in preorder (foldtree-pre), maps in postorder (maptree-post).
|
||||
;; Therefore state changes occur immediately, just by looking at the current
|
||||
;; node, while transformation follows evaluation order. This seems to be the
|
||||
;; most natural approach.
|
||||
;;
|
||||
;; (mapper tree state) - should return transformed tree given current state
|
||||
;; (folder tree state) - should return new state
|
||||
(define (map&fold t zero mapper folder)
|
||||
(let ((head (and (pair? t) (car t))))
|
||||
(cond ((eq? head 'quote)
|
||||
|
|
|
|||
|
|
@ -26,13 +26,15 @@
|
|||
|
||||
(define (dollarsign-transform e)
|
||||
(pattern-expand
|
||||
(pattern-lambda ($ lhs name)
|
||||
(pattern-lambda
|
||||
($ lhs name)
|
||||
(let* ((g (if (not (pair? lhs)) lhs (r-gensym)))
|
||||
(n (if (symbol? name)
|
||||
name ;(symbol->string name)
|
||||
name))
|
||||
(expr `(r-call
|
||||
r-aref ,g (index-in-strlist ,n (r-call attr ,g "names")))))
|
||||
r-aref ,g
|
||||
(index-in-strlist ,n (r-call attr ,g "names")))))
|
||||
(if (not (pair? lhs))
|
||||
expr
|
||||
`(r-block (ref= ,g ,lhs) ,expr))))
|
||||
|
|
@ -50,7 +52,8 @@
|
|||
(let ((g (if (pair? rhs) (r-gensym) rhs))
|
||||
(op (car __)))
|
||||
`(r-block ,@(if (pair? rhs) `((ref= ,g ,rhs)) ())
|
||||
(,op ,lhs (r-call ,(symconcat f '<-) ,@(cddr (cadr __)) ,g))
|
||||
(,op ,lhs (r-call ,(symconcat f '<-)
|
||||
,@(cddr (cadr __)) ,g))
|
||||
,g)))
|
||||
e))
|
||||
|
||||
|
|
@ -64,7 +67,8 @@
|
|||
(default (caddr arg)))
|
||||
`(when (missing ,name)
|
||||
(<- ,name ,default))))
|
||||
(filter (lambda (arg) (not (eq (caddr arg) missing-arg-tag))) arglist)))
|
||||
(filter (lambda (arg) (not (eq (caddr arg) missing-arg-tag)))
|
||||
arglist)))
|
||||
|
||||
; convert r function expressions to lambda
|
||||
(define (normalize-r-functions e)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
; -*- scheme -*-
|
||||
|
||||
; dictionaries ----------------------------------------------------------------
|
||||
; dictionaries ---------------------------------------------------------------
|
||||
(define (dict-new) ())
|
||||
|
||||
(define (dict-extend dl key value)
|
||||
|
|
@ -15,7 +15,7 @@
|
|||
|
||||
(define (dict-keys dl) (map car dl))
|
||||
|
||||
; graphs ----------------------------------------------------------------------
|
||||
; graphs ---------------------------------------------------------------------
|
||||
(define (graph-empty) (dict-new))
|
||||
|
||||
(define (graph-connect g n1 n2)
|
||||
|
|
@ -39,7 +39,7 @@
|
|||
(caar edge-list)
|
||||
(cdar edge-list))))
|
||||
|
||||
; graph coloring --------------------------------------------------------------
|
||||
; graph coloring -------------------------------------------------------------
|
||||
(define (node-colorable? g coloring node-to-color color-of-node)
|
||||
(not (member
|
||||
color-of-node
|
||||
|
|
@ -72,7 +72,7 @@
|
|||
(define (color-pairs pairs colors)
|
||||
(color-graph (graph-from-edges pairs) colors))
|
||||
|
||||
; queens ----------------------------------------------------------------------
|
||||
; queens ---------------------------------------------------------------------
|
||||
(define (can-attack x y)
|
||||
(let ((x1 (mod x 5))
|
||||
(y1 (truncate (/ x 5)))
|
||||
|
|
|
|||
|
|
@ -14,11 +14,14 @@ bq-process
|
|||
|
||||
(list->vector (map-int (lambda (x) `(a b c d e)) 90))
|
||||
|
||||
'((lambda (x y) (if (< x y) x y)) (a b c) (d e f) 2 3 (r t y))
|
||||
'((lambda (x y) (if (< x y) x y))
|
||||
(a b c) (d e f) 2 3 (r t y))
|
||||
|
||||
'((lambda (x y) (if (< x y) x yffffffffffffffffffff)) (a b c) (d e f) 2 3 (r t y))
|
||||
'((lambda (x y) (if (< x y) x yffffffffffffffffffff))
|
||||
(a b c) (d e f) 2 3 (r t y))
|
||||
|
||||
'((lambda (x y) (if (< x y) x y)) (a b c) (d (e zz zzz) f) 2 3 (r t y))
|
||||
'((lambda (x y) (if (< x y) x y))
|
||||
(a b c) (d (e zz zzz) f) 2 3 (r t y))
|
||||
|
||||
'((23 . a) (9 . a) (22 . b) (17 . d) (14 . d) (8 . b) (21 . e)
|
||||
(19 . b) (16 . c) (13 . c) (11 . b) (7 . e) (24 . c) (20 . d)
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
(dotimes (n 99) (color-pairs Q '(a b c d e))))
|
||||
(time (ct))
|
||||
(assert (equal? C
|
||||
'((23 . a) (9 . a) (22 . b) (17 . d) (14 . d) (8 . b) (21 . e)
|
||||
(19 . b) (16 . c) (13 . c) (11 . b) (7 . e) (24 . c) (20 . d)
|
||||
(18 . e) (15 . a) (12 . a) (10 . e) (6 . d) (5 . c) (4 . e)
|
||||
(3 . d) (2 . c) (0 . b) (1 . a))))
|
||||
'((23 . a) (9 . a) (22 . b) (17 . d) (14 . d) (8 . b)
|
||||
(21 . e) (19 . b) (16 . c) (13 . c) (11 . b) (7 . e)
|
||||
(24 . c) (20 . d) (18 . e) (15 . a) (12 . a) (10 . e)
|
||||
(6 . d) (5 . c) (4 . e) (3 . d) (2 . c) (0 . b) (1 . a))))
|
||||
|
|
|
|||
|
|
@ -5,7 +5,10 @@
|
|||
`(eq? (car e) ',(car what)))))))
|
||||
|
||||
(define (every-int n)
|
||||
(list (fixnum n) (int8 n) (uint8 n) (int16 n) (uint16 n) (int32 n) (uint32 n)
|
||||
(list (fixnum n)
|
||||
(int8 n) (uint8 n)
|
||||
(int16 n) (uint16 n)
|
||||
(int32 n) (uint32 n)
|
||||
(int64 n) (uint64 n)))
|
||||
|
||||
(define (every-sint n)
|
||||
|
|
@ -214,10 +217,10 @@
|
|||
|
||||
(load "color.scm")
|
||||
(assert (equal? (color-pairs (generate-5x5-pairs) '(a b c d e))
|
||||
'((23 . a) (9 . a) (22 . b) (17 . d) (14 . d) (8 . b) (21 . e)
|
||||
(19 . b) (16 . c) (13 . c) (11 . b) (7 . e) (24 . c) (20 . d)
|
||||
(18 . e) (15 . a) (12 . a) (10 . e) (6 . d) (5 . c) (4 . e)
|
||||
(3 . d) (2 . c) (0 . b) (1 . a))))
|
||||
'((23 . a) (9 . a) (22 . b) (17 . d) (14 . d) (8 . b)
|
||||
(21 . e) (19 . b) (16 . c) (13 . c) (11 . b) (7 . e)
|
||||
(24 . c) (20 . d) (18 . e) (15 . a) (12 . a) (10 . e)
|
||||
(6 . d) (5 . c) (4 . e) (3 . d) (2 . c) (0 . b) (1 . a))))
|
||||
|
||||
; hashing strange things
|
||||
(assert (equal?
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
#!/bin/sh
|
||||
set -eu
|
||||
CC="${CC:-clang}"
|
||||
CFLAGS="-O2 -falign-functions -Wall -Wno-strict-aliasing -I ../c -D NDEBUG -D USE_COMPUTED_GOTO"
|
||||
CFLAGS="-O2 -falign-functions -Wall -Wno-strict-aliasing"
|
||||
CFLAGS="$CFLAGS -I ../c -D NDEBUG -D USE_COMPUTED_GOTO"
|
||||
LFLAGS="-lm"
|
||||
builddir="build-$(uname | tr A-Z- a-z_)-$(uname -m | tr A-Z- a-z_)"
|
||||
cd "$(dirname "$0")"/..
|
||||
|
|
|
|||
Loading…
Reference in New Issue