12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697 |
- ; -*- mode: scheme; coding: utf-8 -*-
- ; (c) Daniel Llorens - 2016-2017
- ; This library is free software; you can redistribute it and/or modify it under
- ; the terms of the GNU General Public License as published by the Free
- ; Software Foundation; either version 3 of the License, or (at your option) any
- ; later version.
- ; Trying things.
- (import (newra newra) (newra tools) (rnrs io ports)
- (srfi :8) (srfi :26) (ice-9 match) (only (srfi :1) fold)
- (only (rnrs base) vector-map))
- ; -----------------------
- ; can't remember
- ; -----------------------
- (define ra0 (array->ra #(1 2 3)))
- (define ra1 (array->ra #@1(1 2 3)))
- (define ra2 (array->ra #2((1 2) (3 4))))
- (define ra3 (array->ra #2@1@1((1 2) (3 4))))
- (define ra4 (array->ra #3@1@1@-1(((1 2 3) (3 4 5)) ((4 5 6) (6 7 8)))))
- (define ra5 (array->ra #0(99)))
- (define v #(1 2 3 4))
- (define (vector->list-forward v)
- (case (vector-length v)
- ((0) '())
- ((1) (list (vector-ref v 0)))
- (else
- (let ((first (list (vector-ref v 0))))
- (let loop ((last first) (i 1))
- (if (= i (vector-length v))
- first
- (let ((next (list (vector-ref v i))))
- (set-cdr! last next)
- (loop next (+ i 1)))))))))
- ,m (newra newra)
- ; call macro with PARAM according to values OPT of TAG
- (define-syntax %tag-dispatch
- (syntax-rules ()
- ((_ tag macro (opt ...) (param ...) args ...)
- (case tag ((opt) (macro param args ...)) ... (else (throw 'bad-tag tag))))))
- (%tag-dispatch 'TWO display (ONE TWO) ('one 'two))
- ; -----------------------
- ; generalized selector
- ; -----------------------
- ; ...
- ; -----------------------
- ; define-inlinable-case-lambda
- ; -----------------------
- (import (newra newra) (newra tools) (rnrs io ports)
- (srfi :8) (srfi :26) (ice-9 match) (only (srfi :1) fold)
- (only (rnrs base) vector-map))
- ; -----------------------
- ; fold
- ; -----------------------
- ...
- (ra-fold (lambda (a knil) (cons a knil)) '() (ra-iota 3))
- ; think I need to extend %op-loop if I want to do this without set!
- (let-syntax
- ((%fold
- (lambda (stx)
- (syntax-case stx ()
- ((_ op)
- (lambda (stx)
- (syntax-rules ()
- ((_ (a b c) ...)
- #,(#'op (list a b c) ...)))))))))
- ((%fold list) (1 2 3) (4 5 6)))
- (let-syntax
- ((%fold
- (lambda (stx)
- (syntax-case stx ()
- ((_ op) #'op)))))
- (%fold list))
|