Skip to content

Commit

Permalink
compatible with executable pragma
Browse files Browse the repository at this point in the history
  • Loading branch information
damien-mattei committed Nov 24, 2024
1 parent 0ac2825 commit 3e4191b
Show file tree
Hide file tree
Showing 2 changed files with 50 additions and 14 deletions.
32 changes: 25 additions & 7 deletions SRFI-105-curly-infix.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,18 @@
alternating-parameters)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; globals variables that can be modified by coder
(define srfi-strict #f) ; enable strict compatibility with SRFI 105

(define care-of-quote #f) ; keep quoting expression (no $nfx$ will be inserted),
;; usefull to use symbolic expressions
;; (but makes debugging harder because quoted expression to debug will not be the same as executed)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;; library procedures and macro
(define insert cons)
Expand Down Expand Up @@ -143,11 +155,15 @@


; Given curly-infix lyst, map it to its final internal format.
(define (process-curly lyst)
(cond
((not (pair? lyst)) lyst) ; E.G., map {} to ().
(define (process-curly lyst)

(cond

((not (pair? lyst)) lyst) ; E.G., map {} to ().

((null? (cdr lyst)) ; Map {a} to a.
(car lyst))
(car lyst))

((and (pair? (cdr lyst)) (null? (cddr lyst))) ; Map {a b} to (a b).
lyst)

Expand All @@ -158,10 +174,12 @@

;; '{(2 + 3) - (5 - 7)}
;; '(- (2 + 3) (5 - 7))
((and region-quote
(simple-infix-list? lyst)) ; Map {a OP b [OP c...]} to (OP a b [c...])
((and (simple-infix-list? lyst)
(or (and care-of-quote
region-quote)
srfi-strict)) ; Map {a OP b [OP c...]} to (OP a b [c...])

(cons (cadr lyst) (alternating-parameters lyst)))
(cons (cadr lyst) (alternating-parameters lyst)))

;; comment above force this (which is not what i want):
;; > '{(2 + 3) - (5 - 7) - 2}
Expand Down
32 changes: 25 additions & 7 deletions src/curly-infix2prefix4racket.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -40,11 +40,13 @@

(require srfi/31) ;; for 'rec in def.scm

(require SRFI-105/SRFI-105-curly-infix)

(define stderr (current-error-port))

(define stdout (current-output-port))


(include "SRFI-105.scm")

(define srfi-105 #f)

Expand Down Expand Up @@ -126,24 +128,40 @@

(skip-comments-and-empty-lines in)

;; search for executable in racket
(let loop ()
(define try-read (regexp-try-match #px"^#![[:print:]]*racket" in))
(when try-read
(when verbose
(display "try-read : |" stderr) (display try-read stderr) (display "|" stderr) (newline stderr))
(display (car try-read) stdout) ; re-put it on the output port as we need it in the parsed generated file
(newline stdout)
(loop)))

(skip-comments-and-empty-lines in)

;; search for curly infix
(let loop ()
(when (regexp-try-match #px"^#!curly-infix[[:blank:]]*\n" in)
(loop)))

(skip-comments-and-empty-lines in)

;; search for a reader
(let loop ()
(when (regexp-try-match #px"^#lang reader SRFI-105[[:blank:]]*\n" in)
;;(display "srfi 105") (newline)
(loop)))

(skip-comments-and-empty-lines in)


;; search for R6RS
(when (regexp-try-match #px"^#!r6rs[[:blank:]]*\n" in)
(set! flag-r6rs #t)
(display "Detected R6RS code: #!r6rs" stderr) (newline stderr) (newline stderr))

(define lc '())
;; find where the port is set ,line ,column,etc
(define lc '()) ; line number
(define cc '())
(define pc '())
(set!-values (lc cc pc) (port-next-location in))
Expand All @@ -168,7 +186,7 @@
(newline)

(pretty-print result
(current-output-port)
stdout
1)
;;(write result)
;;(newline)
Expand All @@ -185,7 +203,7 @@

(for/list ([expr result])
(pretty-print expr
(current-output-port)
stdout
1))

;; (if (not (null? (cdr result)))
Expand Down Expand Up @@ -250,7 +268,7 @@

;; (if lang-reader
;; (pretty-print code-lst
;; (current-output-port)
;; stdout
;; 1) ;; quote-depth : remove global quote of expression


Expand All @@ -261,7 +279,7 @@
;; (display code-lst) (newline) (newline)

;; (for-each (lambda (expr) (pretty-print expr
;; (current-output-port)
;; stdout
;; 1)) ;; quote-depth : remove global quote of
;; code-lst)

Expand Down

0 comments on commit 3e4191b

Please sign in to comment.