Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-18 21:29:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

new library

Browse source
This commit is contained in:
Justin Ethier 2016-02-13 22:36:49 -05:00
parent af13509e0a
commit faecc90ba2
3 changed files with 51 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -11,6 +11,7 @@ BOOTSTRAP_DIR = ../cyclone-bootstrap
SMODULES = \
scheme/base \
scheme/case-lambda \
scheme/char \
scheme/cxr \
scheme/eval \
@ -81,6 +82,7 @@ bootstrap: icyc
cp gc.c $(BOOTSTRAP_DIR)
cp dispatch.c $(BOOTSTRAP_DIR)
cp scheme/base.c $(BOOTSTRAP_DIR)/scheme
cp scheme/case-lambda.c $(BOOTSTRAP_DIR)/scheme
cp scheme/cxr.c $(BOOTSTRAP_DIR)/scheme
cp scheme/read.c $(BOOTSTRAP_DIR)/scheme
cp scheme/write.c $(BOOTSTRAP_DIR)/scheme

42
macro-testing.scm
View file

@ -45,27 +45,27 @@
; (if test
; (begin result1 result2 ...)
; (guard-aux reraise clause1 clause2 ...)))))
(define-syntax %case
(syntax-rules ()
((%case args len n p ((params ...) . body) . rest)
(if (= len (length '(params ...)))
(apply (lambda (params ...) . body) args)
(%case args len 0 () . rest)))
((%case args len n (p ...) ((x . y) . body) . rest)
(%case args len (+ n 1) (p ... x) (y . body) . rest))
((%case args len n (p ...) (y . body) . rest)
(if (>= len n)
(apply (lambda (p ... . y) . body) args)
(%case args len 0 () . rest)))
((%case args len n p)
(error "case-lambda: no cases matched"))))
(define-syntax case-lambda
(syntax-rules ()
((case-lambda . clauses)
(lambda args (let ((len (length args))) (%case args len 0 () . clauses))))))
;(lambda args (let ((len (length* args))) (%case args len 0 () . clauses))))))
;
; (define-syntax %case
; (syntax-rules ()
; ((%case args len n p ((params ...) . body) . rest)
; (if (= len (length '(params ...)))
; (apply (lambda (params ...) . body) args)
; (%case args len 0 () . rest)))
; ((%case args len n (p ...) ((x . y) . body) . rest)
; (%case args len (+ n 1) (p ... x) (y . body) . rest))
; ((%case args len n (p ...) (y . body) . rest)
; (if (>= len n)
; (apply (lambda (p ... . y) . body) args)
; (%case args len 0 () . rest)))
; ((%case args len n p)
; (error "case-lambda: no cases matched"))))
; (define-syntax case-lambda
; (syntax-rules ()
; ((case-lambda . clauses)
; (lambda args (let ((len (length args))) (%case args len 0 () . clauses))))))
; ;(lambda args (let ((len (length* args))) (%case args len 0 () . clauses))))))
;
;(define-syntax define-values
; (syntax-rules ()
; ((define-values () expr)

28
scheme/case-lambda.sld Normal file
View file

@ -0,0 +1,28 @@
(define-library (scheme case-lambda)
(import (scheme base))
(export
case-lambda
)
(begin
(define-syntax %case
(syntax-rules ()
((%case args len n p ((params ...) . body) . rest)
(if (= len (length '(params ...)))
(apply (lambda (params ...) . body) args)
(%case args len 0 () . rest)))
((%case args len n (p ...) ((x . y) . body) . rest)
(%case args len (+ n 1) (p ... x) (y . body) . rest))
((%case args len n (p ...) (y . body) . rest)
(if (>= len n)
(apply (lambda (p ... . y) . body) args)
(%case args len 0 () . rest)))
((%case args len n p)
(error "case-lambda: no cases matched"))))
(define-syntax case-lambda
(syntax-rules ()
((case-lambda . clauses)
(lambda args (let ((len (length args))) (%case args len 0 () . clauses))))))
;(lambda args (let ((len (length* args))) (%case args len 0 () . clauses))))))
))