From 6e51583f2c2695cc13e11b3d2bb7886647b90792 Mon Sep 17 00:00:00 2001 From: Darcy Shen Date: Mon, 25 Nov 2024 22:17:48 +0800 Subject: [PATCH] Literate (liii cut) --- AUTHORS | 1 + Goldfish.tmu | 238 ++++++++++++++++++++++++++++++++++++++++++ goldfish/liii/cut.scm | 2 +- 3 files changed, 240 insertions(+), 1 deletion(-) diff --git a/AUTHORS b/AUTHORS index 246956b..b7daffd 100644 --- a/AUTHORS +++ b/AUTHORS @@ -16,3 +16,4 @@ Yingyao Zhou Shen Wei Noctis Zhang Andy Yu + diff --git a/Goldfish.tmu b/Goldfish.tmu index edd6509..3dbd7b9 100644 --- a/Goldfish.tmu +++ b/Goldfish.tmu @@ -104,6 +104,8 @@ Noctis Zhang \noctis@umass.edu\ + Andy Yu \andy87654@outlook.com\ + \; @@ -4499,6 +4501,242 @@ \; + + + + + <\goldfish-chunk|goldfish/liii/cut.scm|false|true> + ; + + ; Copyright (C) 2024 The Goldfish Scheme Authors + + ; + + ; Licensed under the Apache License, Version 2.0 (the "License"); + + ; you may not use this file except in compliance with the License. + + ; You may obtain a copy of the License at + + ; + + ; http://www.apache.org/licenses/LICENSE-2.0 + + ; + + ; Unless required by applicable law or agreed to in writing, software + + ; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT + + ; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the + + ; License for the specific language governing permissions and limitations + + ; under the License. + + ; + + \; + + + \; + + <\goldfish-chunk|tests/goldfish/liii/cut-test.scm|false|true> + ; + + ; Copyright (C) 2024 The Goldfish Scheme Authors + + ; + + ; Licensed under the Apache License, Version 2.0 (the "License"); + + ; you may not use this file except in compliance with the License. + + ; You may obtain a copy of the License at + + ; + + ; http://www.apache.org/licenses/LICENSE-2.0 + + ; + + ; Unless required by applicable law or agreed to in writing, software + + ; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT + + ; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the + + ; License for the specific language governing permissions and limitations + + ; under the License. + + ; + + \; + + + \; + + <\goldfish-chunk|goldfish/srfi/srfi-26.scm|false|false> + ; + + ; Copyright (C) 2024 The Goldfish Scheme Authors + + ; + + ; Licensed under the Apache License, Version 2.0 (the "License"); + + ; you may not use this file except in compliance with the License. + + ; You may obtain a copy of the License at + + ; + + ; http://www.apache.org/licenses/LICENSE-2.0 + + ; + + ; Unless required by applicable law or agreed to in writing, software + + ; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT + + ; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the + + ; License for the specific language governing permissions and limitations + + ; under the License. + + ; + + \; + + (define-library (srfi srfi-26) + + \ \ (import (liii cut)) + + \ \ (export cut cute)) + + \; + + + + + <\goldfish-chunk|tests/goldfish/liii/cut-test.scm|true|false> + (import (liii check) + + \ \ \ \ \ \ \ \ (liii cut)) + + \; + + (check-set-mode! 'report-failed) + + \; + + (check ((cut list \\ 'y \\) 'x 'z) =\ '(x y z)) + + (check ((cut + 1 \...\) 2 3) =\ 6) + + (check ((cut + 1 \...\)) =\ 1) + + (check ((cut list \\ \\ \...\) 1 2 3) =\ '(1 2 3)) + + (check ((cut list \\ \\ \...\) 1 2) =\ '(1 2)) + + (check-catch 'wrong-number-of-args ((cut list \\ \\) 1)) + + (check-catch 'wrong-number-of-args ((cut list \\ \\ \...\) 1)) + + (check-catch 'syntax-error ((cut list \\ \\ \...\ \\) 1 2 3)) + + \; + + (check-report) + + \; + + + + + <\goldfish-chunk|goldfish/liii/cut.scm|true|false> + (define-library (liii cut) + + (export cut cute) + + (import (liii list) + + \ \ \ \ \ \ \ \ (liii error)) + + (begin + + \; + + (define-macro (cut . paras) + + \ \ (letrec* + + \ \ \ \ ((slot? (lambda (x) (equal? '\\ x))) + + \ \ \ \ \ (more-slot? (lambda (x) (equal? '\...\ x))) + + \ \ \ \ \ (slots (filter slot? paras)) + + \ \ \ \ \ (more-slots (filter more-slot? paras)) + + \ \ \ \ \ (xs (map (lambda (x) (gensym)) slots)) + + \ \ \ \ \ (rest (gensym)) + + \ \ \ \ \ (parse + + \ \ \ \ \ \ \ (lambda (xs paras) + + \ \ \ \ \ \ \ \ \ (cond + + \ \ \ \ \ \ \ \ \ \ \ ((null? paras) paras) + + \ \ \ \ \ \ \ \ \ \ \ ((not (list? paras)) paras) + + \ \ \ \ \ \ \ \ \ \ \ ((more-slot? (car paras)) `(,rest ,@(parse xs (cdr paras)))) + + \ \ \ \ \ \ \ \ \ \ \ ((slot? (car paras)) `(,(car xs) ,@(parse (cdr xs) (cdr paras)))) + + \ \ \ \ \ \ \ \ \ \ \ (else ‘(,(car paras) ,@(parse xs (cdr paras)))))))) + + \ \ \ \ (cond + + \ \ \ \ \ \ ((null? more-slots) + + \ \ \ \ \ \ \ `(lambda ,xs ,(parse xs paras))) + + \ \ \ \ \ \ (else + + \ \ \ \ \ \ \ \ (when + + \ \ \ \ \ \ \ \ \ \ (or (\ (length more-slots) 1) + + \ \ \ \ \ \ \ \ \ \ \ \ \ \ (not (more-slot? (last paras)))) + + \ \ \ \ \ \ \ \ \ \ (error 'syntax-error "\...\ must be the last parameter of cut")) + + \ \ \ \ \ \ \ \ (let ((parsed (parse xs paras))) + + \ \ \ \ \ \ \ \ \ \ `(lambda (,@xs . ,rest) (apply ,@parsed))))))) + + \; + + (define-macro (cute . paras) + + \ \ (???)) + + \; + + ) ; end of begin + + ) ; end of library + + \; + + 克服了R7RS中无法处理字符串等的缺点。 diff --git a/goldfish/liii/cut.scm b/goldfish/liii/cut.scm index 2dc938d..147b796 100644 --- a/goldfish/liii/cut.scm +++ b/goldfish/liii/cut.scm @@ -48,7 +48,7 @@ `(lambda (,@xs . ,rest) (apply ,@parsed))))))) (define-macro (cute . paras) - (error 'not-implemented)) + (???)) ) ; end of begin ) ; end of library