From 3803db79498c09b57d46c249b8079f77536f7fa3 Mon Sep 17 00:00:00 2001
From: admin <admin@vouivredigital.com>
Date: Fri, 22 Sep 2023 17:30:07 +0900
Subject: [PATCH] Curry some procedures from (rnrs base) and (srfi srfi-1)

---
 base.scm | 560 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 560 insertions(+)
 create mode 100644 base.scm

diff --git a/base.scm b/base.scm
new file mode 100644
index 0000000..377421d
--- /dev/null
+++ b/base.scm
@@ -0,0 +1,560 @@
+(define-module (vdc base)
+  #:use-module ((rnrs base) :prefix rnrs:)
+  #:use-module ((srfi srfi-1) :prefix srfi-1:)
+  #:use-module (vdc curry)
+  #:export
+  (∘)
+  #:replace
+  (boolean?
+   not
+   symbol?
+   symbol->string
+   string->symbol
+   char?
+   char=?
+   char<?
+   char>?
+   char<=?
+   char>=?
+   integer->char
+   char->integer
+   list?
+   null?
+   pair?
+   cons
+   car
+   cdr
+   caar
+   cadr
+   cdar
+   cddr
+   caaar
+   cadar
+   cdaar
+   caddr
+   cdadr
+   cddar
+   cdddr
+   caaaar
+   caaadr
+   caadar
+   cadaar
+   cdaaar
+   cddaar
+   cdadar
+   cdaadr
+   cadadr
+   caaddr
+   caddar
+   cadddr
+   cdaddr
+   cddadr
+   cdddar
+   cddddr
+   number?
+   string?
+   procedure?
+   eq?
+   eqv?
+   equal?
+   symbol=?
+   complex?
+   real-part
+   imag-part
+   make-rectangular
+   make-polar
+   magnitude
+   angle
+   sqrt
+   exp
+   expt
+   log
+   sin
+   cos
+   tan
+   asin
+   acos
+   atan
+   real?
+   rational?
+   numerator
+   denominator
+   rationalize
+   exact?
+   inexact?
+   integer?
+   odd?
+   even?
+   gcd
+   lcm
+   exact-integer-sqrt
+   =
+   <
+   >
+   <=
+   >=
+   zero?
+   positive?
+   negative?
+   length
+   list-ref
+   list-tail
+   append
+   reverse
+   number->string
+   string->number
+   make-string
+   list->string
+   string->list
+   string-length
+   string-ref
+   string-copy
+   substring
+   string=?
+   string<?
+   string>?
+   string<=?
+   string>=?
+   string-append
+   +
+   -
+   *
+   /
+   max
+   min
+   abs
+   truncate
+   floor
+   ceiling
+   round
+   div
+   mod
+   real-valued?
+   rational-valued?
+   integer-valued?
+   nan?
+   infinite?
+   finite?
+   fold
+   fold-right
+   reduce
+   reduce-right
+   map
+   1+
+   identity
+   )
+  )
+
+;; abbreviation
+(define-syntax cudefine (identifier-syntax curried-untyped-define))
+
+(∷ boolean? (0 . 0))
+(cudefine (boolean? x) (rnrs:boolean? x))
+
+(∷ not (0 . 0))
+(cudefine (not x) (rnrs:not x))
+
+(∷ symbol? (0 . 0))
+(cudefine (symbol? x) (rnrs:symbol? x))
+
+(∷ symbol->string (0 . 0))
+(cudefine (symbol->string x) (rnrs:symbol->string x))
+
+(∷ string->symbol (0 . 0))
+(cudefine (string->symbol x) (rnrs:string->symbol x))
+
+(∷ char? (0 . 0))
+(cudefine (char? x) (rnrs:char? x))
+
+(∷ char<? (0 . (0 . 0)))
+(cudefine (char<? x y) (rnrs:char<? x y))
+
+(∷ char>? (0 . (0 . 0)))
+(cudefine (char>? x y) (rnrs:char>? x y))
+
+(∷ char<=? (0 . (0 . 0)))
+(cudefine (char<=? x y) (rnrs:char<=? x y))
+
+(∷ char>=? (0 . (0 . 0)))
+(cudefine (char>=? x y) (rnrs:char>=? x y))
+
+(∷ integer->char (0 . 0))
+(cudefine (integer->char x) (rnrs:integer->char x))
+
+(∷ char->integer (0 . 0))
+(cudefine (char->integer x) (rnrs:char->integer x))
+
+(∷ list? (0 . 0))
+(cudefine (list? x) (rnrs:list? x))
+
+(∷ null? (0 . 0))
+(cudefine (null? x) (rnrs:null? x))
+
+(∷ pair? (0 . 0))
+(cudefine (pair? x) (rnrs:pair? x))
+
+(∷ cons (0 . (0 . 0)))
+(cudefine (cons x y) (rnrs:cons x y))
+
+(∷ car (0 . 0))
+(cudefine (car x) (rnrs:car x))
+
+(∷ cdr (0 . 0))
+(cudefine (cdr x) (rnrs:cdr x))
+
+(∷ caar (0 . 0))
+(cudefine (caar x) (rnrs:caar x))
+
+(∷ cadr (0 . 0))
+(cudefine (cadr x) (rnrs:cadr x))
+
+(∷ cdar (0 . 0))
+(cudefine (cdar x) (rnrs:cdar x))
+
+(∷ cddr (0 . 0))
+(cudefine (cddr x) (rnrs:cddr x))
+
+(∷ caaar (0 . 0))
+(cudefine (caaar x) (rnrs:caaar x))
+
+(∷ caadr (0 . 0))
+(cudefine (caadr x) (rnrs:caadr x))
+
+(∷ cadar (0 . 0))
+(cudefine (cadar x) (rnrs:cadar x))
+
+(∷ cdaar (0 . 0))
+(cudefine (cdaar x) (rnrs:cdaar x))
+
+(∷ caddr (0 . 0))
+(cudefine (caddr x) (rnrs:caddr x))
+
+(∷ cdadr (0 . 0))
+(cudefine (cdadr x) (rnrs:cdadr x))
+
+(∷ cddar (0 . 0))
+(cudefine (cddar x) (rnrs:cddar x))
+
+(∷ cdddr (0 . 0))
+(cudefine (cdddr x) (rnrs:cdddr x))
+
+(∷ caaaar (0 . 0))
+(cudefine (caaaar x) (rnrs:caaaar x))
+
+(∷ caaadr (0 . 0))
+(cudefine (caaadr x) (rnrs:caaadr x))
+
+(∷ caadar (0 . 0))
+(cudefine (caadar x) (rnrs:caadar x))
+
+(∷ cadaar (0 . 0))
+(cudefine (cadaar x) (rnrs:cadaar x))
+
+(∷ cdaaar (0 . 0))
+(cudefine (cdaaar x) (rnrs:cdaaar x))
+
+(∷ cddaar (0 . 0))
+(cudefine (cddaar x) (rnrs:cddaar x))
+
+(∷ cdadar (0 . 0))
+(cudefine (cdadar x) (rnrs:cdadar x))
+
+(∷ cdaadr (0 . 0))
+(cudefine (cdaadr x) (rnrs:cdaadr x))
+
+(∷ cadadr (0 . 0))
+(cudefine (cadadr x) (rnrs:cadadr x))
+
+(∷ caaddr (0 . 0))
+(cudefine (caaddr x) (rnrs:caaddr x))
+
+(∷ caddar (0 . 0))
+(cudefine (caddar x) (rnrs:caddar x))
+
+(∷ cadddr (0 . 0))
+(cudefine (cadddr x) (rnrs:cadddr x))
+
+(∷ cdaddr (0 . 0))
+(cudefine (cdaddr x) (rnrs:cdaddr x))
+
+(∷ cddadr (0 . 0))
+(cudefine (cddadr x) (rnrs:cddadr x))
+
+(∷ cdddar (0 . 0))
+(cudefine (cdddar x) (rnrs:cdddar x))
+
+(∷ cddddr (0 . 0))
+(cudefine (cddddr x) (rnrs:cddddr x))
+
+(∷ number? (0 . 0))
+(cudefine (number? x) (rnrs:number? x))
+
+(∷ string? (0 . 0))
+(cudefine (string? x) (rnrs:string? x))
+
+(∷ procedure? (0 . 0))
+(cudefine (procedure? x) (rnrs:procedure? x))
+
+(∷ eq? (0 . (0 . 0)))
+(cudefine (eq? x y) (rnrs:eq? x y))
+
+(∷ eqv? (0 . (0 . 0)))
+(cudefine (eqv? x y) (rnrs:eqv? x y))
+
+(∷ equal? (0 . (0 . 0)))
+(cudefine (equal? x y) (rnrs:equal? x y))
+
+(∷ symbol=? (0 . (0 . 0)))
+(cudefine (symbol=? x y) (rnrs:symbol=? x y))
+
+(∷ complex? (0 . 0))
+(cudefine (complex? x) (rnrs:complex? x))
+
+(∷ real-part (0 . 0))
+(cudefine (real-part x) (rnrs:real-part x))
+
+(∷ imag-part (0 . 0))
+(cudefine (imag-part x) (rnrs:imag-part x))
+
+(∷ make-rectangular (0 . (0 . 0)))
+(cudefine (make-rectangular x y) (rnrs:make-rectangular x y))
+
+(∷ make-polar (0 . (0 . 0)))
+(cudefine (make-polar x y) (rnrs:make-polar x y))
+
+(∷ magnitude (0 . 0))
+(cudefine (magnitude x) (rnrs:magnitude x))
+
+(∷ angle (0 . 0))
+(cudefine (angle x) (rnrs:angle x))
+
+(∷ sqrt (0 . 0))
+(cudefine (sqrt x) (rnrs:sqrt x))
+
+(∷ exp (0 . 0))
+(cudefine (exp x) (rnrs:exp x))
+
+(∷ expt (0 . (0 . 0)))
+(cudefine (expt x y) (rnrs:expt x y))
+
+(∷ log (0 . 0))
+(cudefine (log x) (rnrs:log x))
+
+(∷ sin (0 . 0))
+(cudefine (sin x) (rnrs:sin x))
+
+(∷ cos (0 . 0))
+(cudefine (cos x) (rnrs:cos x))
+
+(∷ tan (0 . 0))
+(cudefine (tan x) (rnrs:tan x))
+
+(∷ asin (0 . 0))
+(cudefine (asin x) (rnrs:asin x))
+
+(∷ acos (0 . 0))
+(cudefine (acos x) (rnrs:acos x))
+
+(∷ atan (0 . 0))
+(cudefine (atan x) (rnrs:atan x))
+
+(∷ real? (0 . 0))
+(cudefine (real? x) (rnrs:real? x))
+
+(∷ rational? (0 . 0))
+(cudefine (rational? x) (rnrs:rational? x))
+
+(∷ numerator (0 . 0))
+(cudefine (numerator x) (rnrs:numerator x))
+
+(∷ denominator (0 . 0))
+(cudefine (denominator x) (rnrs:denominator x))
+
+(∷ rationalize (0 . (0 . 0)))
+(cudefine (rationalize x eps) (rnrs:rationalize x eps))
+
+(∷ exact? (0 . 0))
+(cudefine (exact? x) (rnrs:exact? x))
+
+(∷ inexact? (0 . 0))
+(cudefine (inexact? x) (rnrs:inexact? x))
+
+(∷ integer? (0 . 0))
+(cudefine (integer? x) (rnrs:integer? x))
+
+(∷ odd? (0 . 0))
+(cudefine (odd? x) (rnrs:odd? x))
+
+(∷ even? (0 . 0))
+(cudefine (even? x) (rnrs:even? x))
+
+(∷ gcd (0 . (0 . 0)))
+(cudefine (gcd x y) (rnrs:gcd x y))
+
+(∷ lcm (0 . (0 . 0)))
+(cudefine (lcm x y) (rnrs:lcm x y))
+
+(∷ exact-integer-sqrt (0 . 0))
+(cudefine (exact-integer-sqrt x) (rnrs:exact-integer-sqrt x))
+
+(∷ = (0 . (0 . 0)))
+(cudefine (= x y) (rnrs:= x y))
+
+(∷ < (0 . (0 . 0)))
+(cudefine (< x y) (rnrs:< x y))
+
+(∷ > (0 . (0 . 0)))
+(cudefine (> x y) (rnrs:> x y))
+
+(∷ <= (0 . (0 . 0)))
+(cudefine (<= x y) (rnrs:<= x y))
+
+(∷ >= (0 . (0 . 0)))
+(cudefine (>= x y) (rnrs:>= x y))
+
+(∷ zero? (0 . 0))
+(cudefine (zero? x) (rnrs:zero? x))
+
+(∷ positive? (0 . 0))
+(cudefine (positive? x) (rnrs:positive? x))
+
+(∷ negative? (0 . 0))
+(cudefine (negative? x) (rnrs:negative? x))
+
+(∷ length (0 . 0))
+(cudefine (length x) (rnrs:length x))
+
+(∷ list-ref (0 . (0 . 0)))
+(cudefine (list-ref lst k) (rnrs:list-ref lst k))
+
+(∷ list-tail (0 . (0 . 0)))
+(cudefine (list-tail lst k) (rnrs:list-tail lst k))
+
+(∷ append (0 . (0 . 0)))
+(cudefine (append x y) (rnrs:append x y))
+
+(∷ reverse (0 . 0))
+(cudefine (reverse x) (rnrs:reverse x))
+
+(∷ number->string (0 . (0 . 0)))
+(cudefine (number->string n radix) (rnrs:number->string n radix))
+
+(∷ string->number (0 . (0 . 0)))
+(cudefine (string->number str radix) (rnrs:string->number str radix))
+
+(∷ make-string (0 . (0 . 0)))
+(cudefine (make-string k char) (rnrs:make-string k char))
+
+(∷ list->string (0 . 0))
+(cudefine (list->string x) (rnrs:list->string x))
+
+(∷ string->list (0 . (0 . (0 . 0))))
+(cudefine (string->list str start end) (rnrs:string->list str start end))
+
+(∷ string-length (0 . 0))
+(cudefine (string-length x) (rnrs:string-length x))
+
+(∷ string-ref (0 . (0 . 0)))
+(cudefine (string-ref str k) (rnrs:string-ref str k))
+
+(∷ string-copy (0 . (0 . (0 . 0))))
+(cudefine (string-copy str start end) (rnrs:string-copy str start end))
+
+(∷ substring (0 . (0 . (0 . 0))))
+(cudefine (substring str start end) (rnrs:substring str start end))
+
+(∷ string=? (0 . (0 . 0)))
+(cudefine (string=? x y) (rnrs:string=? x y))
+
+(∷ string<? (0 . (0 . 0)))
+(cudefine (string<? x y) (rnrs:string<? x y))
+
+(∷ string>? (0 . (0 . 0)))
+(cudefine (string>? x y) (rnrs:string>? x y))
+
+(∷ string<=? (0 . (0 . 0)))
+(cudefine (string<=? x y) (rnrs:string<=? x y))
+
+(∷ string>=? (0 . (0 . 0)))
+(cudefine (string>=? x y) (rnrs:string>=? x y))
+
+(∷ string-append (0 . (0 . 0)))
+(cudefine (string-append x y) (rnrs:string-append x y))
+
+(∷ + (0 . (0 . 0)))
+(cudefine (+ x y) (rnrs:+ x y))
+
+(∷ - (0 . (0 . 0)))
+(cudefine (- x y) (rnrs:- x y))
+
+(∷ * (0 . (0 . 0)))
+(cudefine (* x y) (rnrs:* x y))
+
+(∷ / (0 . (0 . 0)))
+(cudefine (/ x y) (rnrs:/ x y))
+
+(∷ max (0 . (0 . 0)))
+(cudefine (max x y) (rnrs:max x y))
+
+(∷ min (0 . (0 . 0)))
+(cudefine (min x y) (rnrs:min x y))
+
+(∷ abs (0 . 0))
+(cudefine (abs x) (rnrs:abs x))
+
+(∷ truncate (0 . 0))
+(cudefine (truncate x) (rnrs:truncate x))
+
+(∷ floor (0 . 0))
+(cudefine (floor x) (rnrs:floor x))
+
+(∷ ceiling (0 . 0))
+(cudefine (ceiling x) (rnrs:ceiling x))
+
+(∷ round (0 . 0))
+(cudefine (round x) (rnrs:round x))
+
+(∷ div (0 . (0 . 0)))
+(cudefine (div x y) (rnrs:div x y))
+
+(∷ mod (0 . (0 . 0)))
+(cudefine (mod x y) (rnrs:mod x y))
+
+(∷ real-valued? (0 . 0))
+(cudefine (real-valued? x) (rnrs:real-valued? x))
+
+(∷ rational-valued? (0 . 0))
+(cudefine (rational-valued? x) (rnrs:rational-valued? x))
+
+(∷ integer-valued? (0 . 0))
+(cudefine (integer-valued? x) (rnrs:integer-valued? x))
+
+(∷ nan? (0 . 0))
+(cudefine (nan? x) (rnrs:nan? x))
+
+(∷ infinite? (0 . 0))
+(cudefine (infinite? x) (rnrs:infinite? x))
+
+(∷ finite? (0 . 0))
+(cudefine (finite? x) (rnrs:finite? x))
+
+(∷ fold ((0 . (0 . 0)) . (0 . (0 . 0))))
+(cudefine (fold f x xs) (srfi-1:fold f x xs))
+
+(∷ fold-right ((0 . (0 . 0)) . (0 . (0 . 0))))
+(cudefine (fold-right f x xs) (srfi-1:fold-right f x xs))
+
+(∷ reduce ((0 . (0 . 0)) . (0 . 0)))
+(cudefine (reduce f xs) (srfi-1:reduce f (error "empty list") xs))
+
+(∷ reduce-right ((0 . (0 . 0)) . (0 . 0)))
+(cudefine (reduce-right f xs) (srfi-1:reduce-right f (error "empty list") xs))
+
+(∷ map ((0 . 0) . (0 . 0)))
+(cudefine (map f xs) (srfi-1:map f xs))
+
+(∷ 1+ (0 . 0))
+(cudefine (1+ x) (1+ x))
+
+(definec (identity x) x)
+(definec (∘ g f) (λc x (g (f x))))
-- 
2.39.2