Skip to content

Commit

Permalink
Version 9.0
Browse files Browse the repository at this point in the history
  • Loading branch information
@damien-mattei
damien-mattei committed May 25, 2024
1 parent 919ff16 commit 5fc9bd7
Show file tree
Hide file tree
Showing 25 changed files with 1,899 additions and 598 deletions.
4 changes: 2 additions & 2 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -466,15 +466,15 @@ content="text/html; charset=utf-8">Basic hash tables

</pre>
<br>
<br>Programs now needs to be parsed due to the use of optimization
<br><del>Programs now needs to be parsed due to the use of optimization
schemes, for parsing do:

<pre>

curly-infix2prefix4guile.scm your_scheme_file_in_scheme+.scm > your_scheme_file_in_scheme.scm

</pre>

<del>
<p>for the rest read the documentation below and the online examples.</p>
<br>
<h2>2.<u>Download Scheme+:</u></h2>
Expand Down
150 changes: 15 additions & 135 deletions SRFI-105.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,18 +10,7 @@



(define nfx-optim #t)

(define slice-optim #t)

;; library procedures and macro
(define insert cons)

;; insert and set
(define-syntax insert-set!
(syntax-rules ()
((_ expr var)
(set! var (insert expr var)))))


; ------------------------------
Expand Down Expand Up @@ -63,13 +52,17 @@
;;(display "lyst=") (display lyst) (newline)

(if nfx-optim
(begin
(unless (infix? lyst) (error "ERROR: expression is not in infix notation: " lyst))
(let ((e0 (!0 infix-operators-lst-for-parser lyst)))
;;(display "!0 result = ") (display e0) (newline)
(let ((na (n-arity e0)))
;;(display "na =") (display na) (newline)
na)))
;; then
(begin
(unless (infix? lyst operators-lst) (error "ERROR: expression is not in infix notation: " lyst))
(let* ((e0 (!0-generic lyst
infix-operators-lst-for-parser
(lambda (op a b) (list op a b))))
;;(display "!0 result = ") (display e0) (newline)
(na (n-arity e0)))
;;(display "na =") (display na) (newline)
na))
;; else
(cons '$nfx$ lyst)))


Expand All @@ -88,120 +81,6 @@



;; usefull procedures and macro for the next part of code
(define (then=? arg)
(or (equal? arg 'then) (equal? arg 'THEN)))

(define (else=? arg)
(or (equal? arg 'else) (equal? arg 'ELSE)))


;; > (if #f else 3)
;; 3
;; > (if #t else 3)
;; > (if #t 2 else 3)
;; 2
;; > (if #t then 2 else 3)
;; 2
;; > (if #f then 2 else 3)
;; 3
;; > (if #f then 1 2 else 3 4)
;; 4
;; > (if #t then 1 2 else 3 4)
;; 2
;; > (if #t 1 2 3)
;; 3
;; > (if #t then 1 2 else 3 4 then 5)
;; . . SRFI-105.rkt:181:17: if: then after else near : '(then 5)
;; > (if #t then 1 2 else 3 4 else 5)
;; . . SRFI-105.rkt:181:17: if: 2 else inside near: '(else 5)
;; > (if #t else 1 2 then 3 4)
;; . . SRFI-105.rkt:181:17: if: then after else near : '(then 3 4)
;; > (if #t then 1 2 then 3 4)
;; . . SRFI-105.rkt:181:17: if: 2 then inside near: '(then 3 4)
(define (call-parse-if-args Largs) ; Largs = (test e1 ...)

;;(display "Largs=") (display Largs) (newline)
(define lenL (length Largs))

(when (< lenL 2)
(error "if: too few arguments:" Largs))

(define test (car Largs))
(define e1 (cadr Largs))

; deal with the old 2 args 'if' but modified
(condx ((and (= lenL 2) (then=? e1))
(error "if: syntax error,found (if test then) only: near " Largs))
((and (= lenL 2) (else=? e1))
(error "if: syntax error,found (if test else) only: near " Largs))
((= lenL 2) `(when ,test ,e1)) ; (if test e1)
(exec (define e2 (third Largs)))
((and (= lenL 3) (then=? e1)) `(when ,test ; (if test then e2)
,e2))
((and (= lenL 3) (else=? e1)) `(unless ,test ; (if test else e2)
,e2))
((= lenL 3) `(if ,test
,e1
,e2))

(else

(define L-then '())
(define L-else '())
(define cpt-then 0)
(define cpt-else 0)

(define (parse-if-args L)

(condx ((null? L) (set! L-then (reverse L-then))
(set! L-else (reverse L-else)))

(exec (define ec (car L))
(define rstL (cdr L)))

((then=? ec) (when (= cpt-else 1)
(error "if: then after else near :" L))
(when (= cpt-then 1)
(error "if: 2 then inside near:" L))
(set! cpt-then (+ 1 cpt-then))
(parse-if-args rstL)) ; recurse

((else=? ec) (when (= cpt-else 1)
(error "if: 2 else inside near:" L))
(set! cpt-else (+ 1 cpt-else))
(parse-if-args rstL)) ; recurse


((and (>= cpt-then 1) (= cpt-else 0)) (insert-set! ec L-then)
(parse-if-args rstL)) ; recurse


((>= cpt-else 1) (insert-set! ec L-else)
(parse-if-args rstL)) ; recurse

(else ; start with 'then' directives but without 'then' keyword !
;; i allow this syntax but this is dangerous: risk of confusion with regular scheme syntax

(insert-set! ec L-then)

(set! cpt-then 1)
(parse-if-args rstL)))) ; recurse

(define Lr (cdr Largs)) ; list of arguments of 'if' without the test

(parse-if-args Lr) ; call the parsing of arguments

(cond ((null? L-then) `(unless ,test
,@L-else))
((null? L-else) `(when ,test
,@L-then))
(else `(if ,test
(let ()
,@L-then)
(let ()
,@L-else)))))))




Expand Down Expand Up @@ -253,22 +132,23 @@
(let ((datum2 (cons datum
(my-read-delimited-list my-read stop-char port))))

(when (and (list? datum2)
(when (and option-parse-if
(list? datum2)
(not (null? datum2))
(equal? (car datum2) 'if))

(define datum3 (call-parse-if-args (cdr datum2)))

(set! datum2 datum3))
datum2))))))))



(define (parser-$bracket-apply$next-arguments port prefix)
;; create ($bracket-apply$next container args1 args2 ...)
`($bracket-apply$next ,prefix ;; = container (vector,array,hash table ....)
,@(optimizer-parse-square-brackets-arguments (my-read-delimited-list neoteric-read-real #\] port))))
,@(optimizer-parse-square-brackets-arguments-lister (my-read-delimited-list neoteric-read-real #\] port))))



Expand Down
46 changes: 38 additions & 8 deletions Scheme+.scm
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
;; Scheme+.scm

;; version 8.7
;; version 9.0

;; author: Damien MATTEI

Expand All @@ -27,14 +27,15 @@


;; for curly infix notation put in your .guile:
;; (read-enable 'curly-infix)
;; (read-enable 'curly-infix)

;; use :
;; (use-modules (Scheme+))

;; install linux:
;; sudo cp *.scm /usr/share/guile/site/3.0

; in case of problem: rm -rf .cache/guile/

;; example of use with all infixes optimizations:

Expand All @@ -45,7 +46,9 @@
(define-module (Scheme+)
#:use-module (guile)
#:use-module ((guile) #:select ((do . do-scheme)
(while . while-guile)))
(while . while-guile)))
;;(if . if-scheme)))
#:use-module (if-then-else)
#:use-module (for_next_step)
#:use-module (growable-vector)
;;#:use-module (ice-9 local-eval)
Expand All @@ -57,6 +60,10 @@
#:use-module (srfi srfi-1) ;; any,every
#:use-module (srfi srfi-69) ;; Basic hash tables
#:use-module (srfi srfi-31) ;; rec
;;#:use-module (system syntax) ; for syntax?
#:use-module (syntax)
#:use-module (condx)
;;#:use-module (insert)
;;#:use-module (srfi srfi-26) ;; cut <>

;;#:use-module (srfi srfi-43) ;; WARNING: (Scheme+): `vector-copy' imported from both (growable-vector) and (srfi srfi-43)
Expand All @@ -68,7 +75,10 @@
;; use only with scheme-infix-define-macro.scm enabled
;;#:re-export (local-eval the-environment)

#:re-export ( for

;; re-export because they are from modules
#:re-export (
for
for-basic
for-next
for-basic/break
Expand Down Expand Up @@ -107,9 +117,18 @@
find-setter-for-overloaded-square-brackets

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

condx
;;if

)

#:re-export-and-replace (if)

;;#:replace (if do when unless while)
#:replace (do when unless while)

#:export ( $nfx$
Expand All @@ -119,15 +138,17 @@
$bracket-apply$
$bracket-apply$next

parse-square-brackets-arguments ; exported for debug
;;infix? n-arity !*prec-generic !*-generic ;; parse-square-brackets-arguments ; exported for debug
;;infix-operators-lst-for-parser-syntax infix-operators-lst-for-parser ;; for debug
;;check-syntax=? ;; for debug

<- ← :=
-> →
<+ ⥆ :+
+> ⥅
declare
$> $+>
condx
;;condx
≠
<> ;; is also used as keyword in srfi 26, comment this line if SRFI 26 is used and use the ≠ symbol in your code
**
Expand All @@ -143,7 +164,10 @@
) ;; end module definitions


;;(include-from-path "if.scm")
;;(include-from-path "if-then-else.scm")

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

;; must know 'for' before use unless that scheme will suppose a procedural call instead of a macro expansion
Expand All @@ -152,21 +176,27 @@
(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 "when-unless.scm")
(include-from-path "while-do.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 "syntax.scm")
(include-from-path "operation-redux.scm")
(include-from-path "optimize-infix.scm")
(include-from-path "optimize-infix-slice.scm")

(include-from-path "assignment.scm")
(include-from-path "apply-square-brackets.scm")
Expand Down
3 changes: 3 additions & 0 deletions TODO
View file
Original file line number Diff line number Diff line change
@@ -1,2 +1,5 @@


( infix )
add more infix without { } in do while / repeat until / ... ?
in $nfx$ see TODO
Loading

0 comments on commit 5fc9bd7

Please sign in to comment.