Skip to content

Commit

Permalink
guile
Browse files Browse the repository at this point in the history
  • Loading branch information
@damien-mattei
damien-mattei committed Nov 22, 2023
1 parent ba4f616 commit a773c85
Show file tree
Hide file tree
Showing 9 changed files with 550 additions and 149 deletions.
147 changes: 100 additions & 47 deletions Scheme+.scm
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
;; Scheme+.scm

;; version 7.1
;; version 7.2

;; author: Damien MATTEI

Expand Down Expand Up @@ -35,57 +35,110 @@
;; install linux:
;; sudo cp *.scm /usr/share/guile/site/3.0

(define-module (Scheme+)

(use-modules (growable-vector)
(overload)
#:use-module (for_next_step)
#:use-module (growable-vector)
;;#:use-module (ice-9 local-eval)
(ice-9 match)
(ice-9 arrays) ;; for array-copy
(srfi srfi-1) ;; any,every
(srfi srfi-69) ;; Basic hash tables
(srfi srfi-31) ;; rec
(srfi srfi-26) ;; cut
#:use-module (infix-operators)
#:use-module (overload)
#:use-module (array)
#:use-module (ice-9 match)
#:use-module (ice-9 arrays) ;; for array-copy
#:use-module (srfi srfi-1) ;; any,every
#:use-module (srfi srfi-69) ;; Basic hash tables
#:use-module (srfi srfi-31) ;; rec
#:use-module (srfi srfi-26) ;; cut

;;#:use-module (srfi srfi-43) ;; WARNING: (Scheme+): `vector-copy' imported from both (growable-vector) and (srfi srfi-43)
)
;; use with scheme-infix.scm included from module (caveit with overloading)
;; or with scheme-infix.scm included in main not module (ok)
;;#:use-module (apply-square-brackets)




(include "def.scm")
;;(include "array.scm") ;; MUST be included after assignment .....
(include "set-values-plus.scm")

(include "for_next_step.scm") ;; for apply-square-brackets.scm, assignment.scm
;; if you want it at toplevel: (include "for_next_step.scm") or add some export in this file....


(include "declare.scm")
(include "condx.scm")
(include "block.scm")
(include "not-equal.scm")
(include "exponential.scm")
(include "while-do-when-unless.scm")
(include "repeat-until.scm")
(include "modulo.scm")
(include "bitwise.scm")



;; must be included from program file now ! (use "scheme-infix.scm" in included-files of scheme+ directory)



;;(include "scheme-infix-define-macro.scm")




(include "slice.scm")


;; use with scheme-infix-define-macro.scm (ok)
;;#:export (infix-with-precedence2prefix ! quote-all overload overload-procedure overload-operator overload-function $nfx$ def $bracket-apply$ <- ← -> → <+ ⥆ +> ⥅ declare $ $> condx ≠ ** <v v> ⇜ ⇝ repeat % << >> & | ) ;; <>


;; use only with scheme-infix-define-macro.scm enabled
;;#:re-export (local-eval the-environment)

#:re-export (for
for-basic
for-next
for-basic/break
for-basic/break-cont
for/break-cont
for-each-in
in-range
reversed

define-overload-procedure
overload-procedure

define-overload-existing-procedure
overload-existing-procedure

define-overload-operator
overload-operator

define-overload-existing-operator
overload-existing-operator

define-overload-n-arity-operator
overload-n-arity-operator

define-overload-existing-n-arity-operator
overload-existing-n-arity-operator

overload-function ;; see how to do the same for operator, see the possible problem with infix precedence?


;;$ovrld-square-brackets-lst$

overload-square-brackets
;;find-getter-and-setter-for-overloaded-square-brackets
find-getter-for-overloaded-square-brackets
find-setter-for-overloaded-square-brackets

infix-operators-lst
set-infix-operators-lst!
replace-operator!
)

#:replace (do when unless)

#:export ($nfx$
!*prec

def $bracket-apply$ <- ← -> → <+ ⥆ +> ⥅ declare $> $+> condx ≠ ** <v v> ⇜ ⇝ repeat % << >> & $ | ) ;; <> is already defined in Guile

) ;; end module definitions



(include-from-path "def.scm")

;; must know 'for' before use unless that scheme will suppose a procedural call instead of a macro expansion
;; and will issue definition in expression context error

(include-from-path "set-values-plus.scm")

(include-from-path "declare.scm")
(include-from-path "condx.scm")
(include-from-path "block.scm")
(include-from-path "not-equal.scm")
(include-from-path "exponential.scm")
(include-from-path "while-do-when-unless.scm")
(include-from-path "repeat-until.scm")
(include-from-path "modulo.scm")
(include-from-path "bitwise.scm")

(include-from-path "scheme-infix.scm")

;;(include-from-path "scheme-infix-define-macro.scm")

(include-from-path "slice.scm")

(include-from-path "assignment.scm")
(include-from-path "apply-square-brackets.scm")



52 changes: 42 additions & 10 deletions array.scm
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
;; arrays

;; guile version

;; This file is part of Scheme+

;; Copyright 2021-2023 Damien MATTEI
Expand All @@ -22,6 +24,28 @@
;; TODO : make a version vector with resizable arrays using classes
;; cf: https://www.gnu.org/software/guile/manual/html_node/GOOPS.html

(define-module (array)

#:use-module (for_next_step)

#:export (make-array-2d
array-2d-ref
array-2d-set!
create-vector-2d
negative-vector-index
function-array-n-dim-ref
function-array-n-dim-set!
display-array-2d
dv-2d
funct-array-2d-set!
funct-array-2d-ref
array-ref-set!
srfi25-array-set!))


;;(include "./for_next_step.scm")


;; the value v should be put before in a let to avoid multiple evaluation after macro expand
(define-syntax make-array-2d
(syntax-rules ()
Expand Down Expand Up @@ -54,17 +78,24 @@
((_ array lin col val) (vector-set! (vector-ref array lin) col val))))

;; create a vector of line and column with a function
;; (define (create-vector-2d fct lin col)
;; {v <+ (make-vector lin)}
;; ;;(display "ok") (newline)
;; (for ({l <+ 0} {l < lin} {l <- l + 1})
;; {v[l] <- (make-vector col)}
;; (for ({c <+ 0} {c < col} {c <- c + 1})
;; {v[l][c] <- (fct l c)}))
;; v)

;; create a vector (or array) of line and column with a function
(define (create-vector-2d fct lin col)
{v <+ (make-vector lin)}
;;(display "ok") (newline)
(for ({l <+ 0} {l < lin} {l <- l + 1})
{v[l] <- (make-vector col)}
(for ({c <+ 0} {c < col} {c <- c + 1})
{v[l][c] <- (fct l c)}))
(define v (make-vector lin))
(for ((define l 0) (< l lin) (set! l (+ l 1)))
(vector-set! v l (make-vector col))
(for ((define c 0) (< c col) (set! c (+ c 1)))
(array-2d-set! v l c (fct l c))))
v)



;; scheme@(guile-user)> (define arr (make-array-2d 10 7 0))
;; scheme@(guile-user)> (array-n-dim-ref arr 4 3)
;; 0
Expand Down Expand Up @@ -128,7 +159,8 @@
(syntax-rules ()
((_ array)
(for-basic (y 0 (- (vector-length array) 1))
(display-nl (vector-ref array y))))))
(display (vector-ref array y))
(newline)))))


;; > (define _quai 34)
Expand All @@ -139,7 +171,7 @@
((_ var) (begin
;;(display (symbol->string (quote var)))
(display (quote var))
(display-nl " = ")
(display " = ")(newline)
(display-array-2d var)
(newline)))))

Expand Down
17 changes: 11 additions & 6 deletions first-and-rest.scm
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,13 @@
;; this for scheme implementation other than DrRacket and that do not have first and rest
(define-syntax first
(syntax-rules ()
((_ p) (car p))))
;; (define-syntax first
;; (syntax-rules ()
;; ((_ p) (car p))))

;; (define-syntax rest
;; (syntax-rules ()
;; ((_ p) (cdr p))))


(define first car)
(define rest cdr)

(define-syntax rest
(syntax-rules ()
((_ p) (cdr p))))
83 changes: 79 additions & 4 deletions for_next_step.scm
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
;; Copyright 2022 Damien MATTEI
;; Copyright 2022-2023 Damien MATTEI

;; guile version

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Expand All @@ -14,11 +16,22 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.


;;(require (rename-in racket/base [for for-rack])) ;; backup original Racket 'for'


;; (define-module (for-next-step)
;; #:export (break continue for))
(define-module (for_next_step)
#:export (for
for-basic
for-next
for-basic/break
for-basic/break-cont
for/break-cont
for-each-in
in-range
reversed
))

(include-from-path "increment.scm")


;; > (for-basic ((k 5)) (display k) (newline))
;; 0
Expand Down Expand Up @@ -505,3 +518,65 @@
;; body ...)))
;; incrmt
;; (loop))))))))))



(define-syntax for-each-in

(syntax-rules ()

((_ (i seq) stmt0 stmt1 ...) (for-each (lambda (i) stmt0 stmt1 ...)
seq))))


;; |kawa:2|# (in-range 5)
;; (0 1 2 3 4)
;; #|kawa:3|# (in-range 1 5)
;; (1 2 3 4)
;; #|kawa:4|# (in-range 1 5 2)
;;(1 3)
(define (in-range . arg-lst)
(define n (length arg-lst))
(when (or (= n 0) (> n 3))
(error "in-range: bad number of arguments"))
(define start 0)
(define stop 1)
(define step 1)
(define res '())

(case n
((0) (error "in-range : too few arguments"))
((1) (set! stop (car arg-lst)))
((2) (begin (set! start (car arg-lst))
(set! stop (cadr arg-lst))))
((3) (begin (set! start (car arg-lst))
(set! stop (cadr arg-lst))
(when (= 0 step)
(error "in-range: step is equal to zero"))
(set! step (caddr arg-lst)))))

(define (arret step index stop)
(if (> step 0)
(< index stop)
(> index stop)))

(for ((define i start) (arret step i stop) (set! i (+ step i)))
(set! res (cons i res)))

(reverse res))



;; #|kawa:3|# (in-range 1 11 3)
;; (1 4 7 10)
;; #|kawa:4|# (reversed (in-range 1 11 3))
;; (10 7 4 1)
;; #|kawa:5|# (in-range 8 1 -2)
;; (8 6 4 2)
;; #|kawa:6|# (reversed (in-range 8 1 -2))
;; (2 4 6 8)
;; #|kawa:7|# (in-range 8 1 -1)
;; (8 7 6 5 4 3 2)
;; #|kawa:8|# (reversed (in-range 8 1 -1))

(define reversed reverse)
5 changes: 5 additions & 0 deletions increment.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,11 @@
((_ x) (begin (set! x (+ x 1))
x))))

(define-syntax inc!
(syntax-rules ()
((_ x) (begin (set! x (+ x 1))
x))))

(define-syntax add1
(syntax-rules ()
((_ x) (+ x 1))))
Loading

0 comments on commit a773c85

Please sign in to comment.