regular expression

curly-infix2prefix4racket.scm

#! /usr/bin/env racket

;;#lang racket

;; Copyright (C) 2012 David A. Wheeler and Alan Manuel K. Gloria. All Rights Reserved.

;; Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

;; modification for Racket by Damien Mattei

;; use with: racket curly-infix2prefix4racket.scm [options] file2parse.scm > parsedfile.scm

;; example in DrRacket :

;; with an R6RS file (autodetection):
;; ../SRFI-105-for-Racket/src/curly-infix2prefix4racket.rkt  --verbose ../Scheme-PLUS-for-Racket-R6RS/examples/chaos+.rkt > ../Scheme-PLUS-for-Racket-R6RS/examples/chaos.rkt

;; with a normal Scheme+ file (autodetection):
;; /Applications/Racket\ v8.12/bin/racket curly-infix2prefix4racket.rkt  ../../../../AI_Deep_Learning/exo_retropropagationNhidden_layers_matrix_v2_by_vectors+.rkt > ../../../../AI_Deep_Learning/exo_retropropagationNhidden_layers_matrix_v2_by_vectors.rkt

;; options:

;; --verbose : display code on stderr too 


(module curlyinfix racket


;;(require syntax/strip-context) ;; is this useful?

(require racket/pretty) ;; pretty print

;;(require racket/cmdline) ;; (command-line) does not work like in other scheme implementations



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

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

(define stderr (current-error-port))

;;(include "SRFI-105.scm")



(define srfi-105 #f)

;; quiet mode that do not display on standart error the code
(define verbose #f)

(define flag-r6rs #f)

(define (skip-comments-and-empty-lines in)
  
  ;; (define li '())
  ;; (define fpos '())
  ;; (define cpt -1)

  ;; (do
  ;;     (set! cpt (+ 1 cpt))
  ;;     (set! fpos (file-position in))
  ;;     (set! li (read-line in))
  ;;     while (test-blank-lines-or-comments li))
  
  ;; (file-position in fpos) ;; rewind to the code to parse after comments or spaces

  ;; (do
  ;;     while (or (regexp-try-match #px"^[[:space:]]" in)  ; skip space,tab,new line,...
  ;; 		(regexp-try-match #px"^;[^\n]*\n" in)))  ; and also comments

  (let loop ()
    (when  (or (regexp-try-match #px"^[[:space:]]" in)  ; skip space,tab,new line,...
	       (regexp-try-match #px"^;[^\n]*\n" in))
      (loop)))  ; and also comments

  ;; (display "SRFI-105.rkt : skip-comments-and-empty-lines : number of skipped lines (comments, spaces) at beginning : ")
  ;; (display cpt)
  ;; (newline)
  )
   

(define (literal-read-syntax src)

  (define in (open-input-file src))
  (define lst-code (process-input-code-tail-rec in))
  ;; (if lang-reader
  ;;     `(module aschemeplusprogram racket ,@lst-code)
  lst-code)
 ;;)
;;(cons 'module (cons 'aschemeplusprogram (cons 'racket lst-code))))
;; (strip-context `(module aschemeplusprogram racket ,@lst-code))) ;; is this useful?








;; read all the expression of program
;; a tail recursive version
(define (process-input-code-tail-rec in) ;; in: port

  (define (process-input-code-rec-tail-recursive acc)
    (define result (curly-infix-read in))  ;; read an expression
    (if (eof-object? result)
	(reverse acc)
	(process-input-code-rec-tail-recursive (cons result acc))))


  

  (when verbose
	(display "SRFI-105 Curly Infix parser with operator precedence by Damien MATTEI" stderr) (newline stderr)
	(display "(based on code from David A. Wheeler and Alan Manuel K. Gloria.)" stderr) (newline stderr) (newline stderr)
	(newline stderr))

  
  (port-count-lines! in) ; turn on counting on port

  (when verbose
    (display "Possibly skipping some header's lines containing space,tabs,new line,etc  or comments or curly infix directives." stderr) (newline stderr) (newline stderr))
  
  (skip-comments-and-empty-lines in)

  (let loop ()
    (define try-read (regexp-try-match #px"^#![[:blank:]]*/[[:ascii:]]*racket[[:blank:]]*\n" in))
    (when  try-read
	   ;;(display "executable") (newline)
	   (display "|" stderr) (display try-read stderr) (display "|" stderr) (newline stderr)
	   (display (car try-read) (current-output-port))
	   (loop)))

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

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

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

  (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)
  
  (when (regexp-try-match #px"^#!r6rs[[:blank:]]*\n" in)
	(set! flag-r6rs #t)
	(display "Detected R6RS code: #!r6rs" stderr) (newline stderr) (newline stderr))

  ;; 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))

  (when verbose
    (display "SRFI-105.rkt : number of skipped lines (comments, spaces, directives,...) at header's beginning : " stderr)
    (display lc stderr)
    (newline stderr)
    (newline stderr)
  
    (display "Parsed curly infix code result = " stderr) (newline stderr) (newline stderr))
  

  (if flag-r6rs
      
      (let ((result (curly-infix-read in))) ;; read an expression
	
	(when (eof-object? result)
	    (error "ERROR: EOF : End Of File : " result))
	;;(display "(module aschemeplusr6rsprogram r6rs")
	(display "#!r6rs")
	(newline)
 	
	(pretty-print result
		      (current-output-port)
		      1)
	;;(write result)
	;;(newline)
	;;(display ")")
	(newline)
	;;result

	)

      ;; r5rs
      (let ((result (process-input-code-rec-tail-recursive '())))
	(when (null? result)
	  (error "ERROR: Empty program."))

	(for/list ([expr result])
		  (pretty-print expr
				(current-output-port)
				1))
	
	;; (if (not (null? (cdr result)))
	;;     ;; put them in a module
	;;     `(module aschemeplusprogram racket ,@result)
	;;     ;; only one
	;;     (let ((fst (car result)))
	;;       ;; searching for a module
	;;       (if (and (list? fst)
	;; 	       (not (null? fst))
	;; 	       (equal? 'module (car fst)))
	;; 	  fst ; is the result module
	;; 	  `(module aschemeplusprogram racket ,fst))))

	)))
	


; parse the input file from command line
(define cmd-ln-vect (current-command-line-arguments))

;;(display "cmd-ln-vect=") (display cmd-ln-vect) (newline)

(define cmd-ln (vector->list cmd-ln-vect))

(define options cmd-ln)
;;(display "options= ") (display options) (newline)

(when (member "--help" options)
      (display "curly-infix2prefix4racket.scm documentation: (see comments in source file for more examples)") (newline) (newline) 
      (display "racket curly-infix2prefix4racket.scm [options] file2parse.scm") (newline) (newline)
      (display "  or simply :") (newline) (newline)
      (display "curly-infix2prefix4racket.scm [options] file2parse.scm") (newline) (newline)
      (display "options:") (newline)(newline)
     ;; (display "  --srfi-105 : set strict compatibility mode with SRFI-105 ") (newline) (newline)
      (display "  --verbose : display code on stderr too ") (newline) (newline)
      (exit))



(when (member "--verbose" options)
      (set! verbose #t))



(define file-name (car (reverse cmd-ln)))

(when (string=? (substring file-name 0 2) "--")
      (error "filename start with -- ,this is confusing with options."))

(define code-lst (literal-read-syntax file-name))


;; (define (wrt-expr expr)
;;   (write expr) ;; without 'write' string delimiters disappears !
;;   (newline)
;;   (newline))


;;(for-each wrt-expr code-lst)
;;(wrt-expr code-lst)

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


;; (when flag-r6rs
;;       (display "#!r6rs") (newline)
;;       (newline))

;; (display code-lst) (newline) (newline)

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

)

interpole_fields+.rkt

#! /usr/bin/env racket

#lang reader SRFI-105

;; interpolate field caller

;; Damien MATTEI

;; export PATH=/Applications/Racket/bin:$PATH

;; TODO: use Makefile

(module interpolate-field-caller racket
	
	(require Scheme+)
		 

	(require setup/dirs)
	(require racket/date)
	(require srfi/13) ; for at least string-contains

	(require xml
		 (except-in 2htdp/batch-io xexpr?)) ; for: read-lines
	
	(display "Scheme+ : interpole_fields") (newline)

	(display "interpole-fields : Racket/Scheme+ library search directory: ") (display (get-lib-search-dirs)) (newline)
	(display "interpole-fields : Racket/Scheme+ library collection links:" ) (display (current-library-collection-links)) (newline)

	(define cmd-ln-vect (current-command-line-arguments)) ; get the command line

	{trajectory-txt <- cmd-ln-vect[0]} ; trajectory
	(display "interpole-fields : trajectory-txt=") (display trajectory-txt) (newline)

	;; creating a temporary directory for output of computation (physical data value at trajectory points)
	{output-dir <- (string-append trajectory-txt "_directory")}
	(display "interpole-fields : output-dir=") (display output-dir) (newline)
	;;(make-directory* trajectory-txt)
	(make-directory* output-dir)

	(define trajectory-file (string-append trajectory-txt ".txt"))
	(display "interpole-fields : trajectory-file=") (display trajectory-file) (newline)

	{trajectory-xml <- (string-append trajectory-txt ".xml")}
	;; open output XML file (because PHP had already created a partial header)
	(define xml-file (open-output-file #:exists 'append trajectory-xml))
	

	;; launcher directory (web server, command line shell ...)
	(define cur-dir (current-directory))
	(display "interpole-fields : launcher current directory=") (display cur-dir) (newline)
	
	(current-directory (build-path (current-directory) "drive")) ; setting the current directory for interpolation
	(define interpol-dir (current-directory))
	(display "interpole-fields : directory for interpolation=") (display interpol-dir) (newline)

	;; setting Python paths
	(define python-path (getenv "PYTHONPATH"))
	(display "interpole-fields : PYTHONPATH=") (display python-path) (newline)
	(when (not python-path)
	      (display "interpole-fields : setting PYTHONPATH") (newline)
	      (putenv "PYTHONPATH" ".:fibo") ;:drive/.:drive/fibo")
	      {python-path <- (getenv "PYTHONPATH")} ;(set! python-path (getenv "PYTHONPATH")) 
	      (display "interpole-fields : PYTHONPATH=") (display python-path) (newline))

	;; (define (with-all-output-to-string proc)
	;;   (call-with-output-string
	;;    (λ (p) (parameterize ([current-output-port p]
	;; 			      [current-error-port p])
	;; 			     (proc)))))

	
	;; (define str-out-err (with-all-output-to-string (λ () (system* "/bin/rm" ;;"/bin/rm"
	;; 								    ;;"-f"
	;; 								    ;;"drve/output/trajectory-near_Mio_B_6000.txt"
	;; 								    "./drive/output/trajectory-near_Mio_rhoe0_6000.txt"
	;; 								    ))))
	;; (display "str-out-err=") (display str-out-err) (newline)

	{B-file := (string-append output-dir "/trajectory-near_Mio_B_6000.txt")}
	{rhoe-file := (string-append output-dir "/trajectory-near_Mio_rhoe0_6000.txt")}
	
	(define prcss-lst (process*  "/bin/rm"
				     ;;"-f"
				     B-file ;"output/trajectory-near_Mio_B_6000.txt"
				     rhoe-file ;"output/trajectory-near_Mio_rhoe0_6000.txt"
				     #:set-pwd? interpol-dir))

	(display "interpole_fields : prcss-lst =") (display prcss-lst) (newline)
	(define prcss-vct (list->vector prcss-lst))
	{eff-stdout <- prcss-vct[0]}
	{eff-stdin <- prcss-vct[1]}
	{eff-id <- prcss-vct[2]}
	{eff-stderr <- prcss-vct[3]}
	{eff-proc-ctrl <- prcss-vct[4]}
	
	;;(display "interpole_fields : passed") (newline)
	
	(define eff-err-lns (port->lines eff-stderr))
	(define eff-len-err-lns (length eff-err-lns))
	(display "number of lines in eff-stderr=") (display eff-len-err-lns) (newline)
	(when {eff-len-err-lns > 0}
	      (display "Effaceur Error lines:") (display eff-err-lns) (newline))

	(define eff-out-lns (port->lines eff-stdout))
	(display "Output of effaceur:") (display eff-out-lns) (newline)
	
	;; (define-values (subby stdout stdin stderr) (subprocess #f #f #f
	;; 						       ;;"/usr/bin/env"
	;; 						       ;;"/bin/ls"
	;; 						       "/Library/Frameworks/Python.framework/Versions/3.11/bin/python3.11"
	;; 						       "cut_1D.py"
	;; 						       "../Data"
	;; 						       "BepiColombo-Mio_MSO-orbit_1min_short.txt"
	;; 						       "output"))
	;; ;;(display "subby=") (display subby) (newline)
	;; (subprocess-wait subby)

	(display "interpole_fields : start of Interpolation code in Python: ") (display (current-date)) (newline)

	;; this launch the Interpolation code in Python
	(define prcss-python-lst (process*  "/Library/Frameworks/Python.framework/Versions/3.11/bin/python3.11"
					    "cut_1D.py" ; the interpolation code
					    "../Data"
					    trajectory-file ; "BepiColombo-Mio_MSO-orbit_1min_short.txt"
					    output-dir ;"output"
					    #:set-pwd? interpol-dir))

	;;(display "End of execution Python code.") (newline)
	
	;;(display "interpole_fields : prcss-python-lst =") (display prcss-python-lst) (newline)
	(define prcss-python-vct (list->vector prcss-python-lst))
	{stdout <- prcss-python-vct[0]}
	{stdin <- prcss-python-vct[1]}
	{python-id <- prcss-python-vct[2]}
	{stderr <- prcss-python-vct[3]}
	{python-proc-ctrl <- prcss-python-vct[4]}

	
	(define err-lns (port->lines stderr))
	(define len-err-lns (length err-lns))
	(display "number of lines in stderr=") (display len-err-lns) (newline)
	(when {len-err-lns > 0}
	      (display "Error lines:") (display err-lns) (newline))
	
	(define out-lns (port->lines stdout))
	;;(display "Output of python interpolation code:") (newline) (display out-lns) (newline)
	(define out-lns-vct (list->vector out-lns))
	{last-text <- out-lns-vct[-1]} ; the last text should contains the status ,CPU if not fail

	(display "interpole_fields : end of Interpolation code in Python: ") (display (current-date)) (newline)

	;; get the resulting path file list
	(define output-path-file-lst (directory-list output-dir))
	{output-file-lst <- (map path->string output-path-file-lst)} ; convert path in string
	{possible-output-file-lst <- (filter (λ (str) (string-contains str "trajectory-near_"))
					     output-file-lst)}

	(declare output-file)
	(if (null? possible-output-file-lst)
	    (error "interpole_fields : can not find an output file")
	    {output-file <- (first possible-output-file-lst)}) ; take the first one (normally should be only one)

	(display "interpole_fields : output-file: ") (display output-file) (newline)

	{output-file-with-path <- (string-append output-dir "/" output-file)}

	(display "interpole_fields : output-file-with-path: ") (display output-file-with-path) (newline)

	;; reading output file of interpolated data
	;; read all lines
	{output-file-lines <- (read-lines output-file-with-path)}
	{vl <- (list->vector output-file-lines)}
					
	;; the first header line that contains comments
	{head <- vl[0]}
	{(sharp-index xs ys zs vx vy vz) <- (apply values (string-split head))}

	;; append the fields for data value of the cube at interpolation point in the XML file (PHP already created a partial header)
	(define xexpr
	  `(FIELD ((name ,vx)
		   (ID "col5")
		   (ucd "")
		   (utype "")
		   (datatype "float")
		   (width "")
		   (unit ""))))

	(display-xml/content (xexpr->xml xexpr)
			     #:indentation 'classic
			     xml-file)

	{xexpr <- `(FIELD ((name ,vy)
			   (ID "col6")
			   (ucd "")
			   (utype "")
			   (datatype "float")
			   (width "")
			   (unit "")))}

	(display-xml/content (xexpr->xml xexpr)
			     #:indentation 'classic
			     xml-file)

	{xexpr <- `(FIELD ((name ,vz)
			   (ID "col7")
			   (ucd "")
			   (utype "")
			   (datatype "float")
			   (width "")
			   (unit "")))}

	(display-xml/content (xexpr->xml xexpr)
			     #:indentation 'classic
			     xml-file)

	;; read all lines of trajectory file text to get the timestamps (because we have only index in Python output interpolated file)
	{input-lines <- (read-lines trajectory-file)}
	{vl-trajectory <- (list->vector input-lines)}
	{data-trajectory <- vl-trajectory[5 :]} ; skip the header to go to the data lines

	;;{data-interpol <- vl[1 :]} ; the numerical data lines without the header commented line
	
	(newline xml-file)
	
	(display " interpole_fields : last-text=") (display last-text) ; this last line should be in $message variable of PHP caller
       

	;; for my program the outport port of the subprocess are my input ports and vice versa
	(close-input-port stdout)
	(close-output-port stdin)
	(close-input-port stderr)

) ; end module