#!/bin/sh
# -*- scheme -*-
exec guile $0 "$@"
!#

(use-modules (nyacc lang modelica parser))
(use-modules (nyacc lang sx-util))
(use-modules ((srfi srfi-1) #:select (fold fold-right)))
(use-modules (srfi srfi-37))
(use-modules (ice-9 pretty-print))

(define (sf fmt . args) (apply simple-format #t fmt args))
(define (pp exp) (pretty-print exp #:per-line-prefix "  "))

(define (fail fmt . args)
  (apply simple-format (current-error-port)
	 (string-append "nxmodelica: " fmt "\n")
	 args)
  (exit 1))

(define (show-help)
  (sf "usage: nxmodelica [-h] [-g model] file\n")
  (sf "       -h --help    print help and exit\n")
  (sf "       -g model     generate model\n")
  (sf "       --gen=model  generate model\n")
  (quit))

(define options
  (list (option '(#\h "help") #f #f
		(lambda (opt name arg seed)
		  (acons 'help #t seed)))
	(option '(#\g "gen") #t #f
		(lambda (opt name arg seed)
		  (acons 'gen arg seed)))
	))

(define (parse-args args)
  (args-fold args options
	     (lambda (opt name arg seed)
	       (fail "unrecognized option: ~S" name)
	       (exit 1))
	     (lambda (file seed)
	       (if (string-suffix? file ".mo")
		   (fail "expecting .mo file"))
	       (acons 'files (cons file (assq-ref seed 'files)) seed))
	     '((files))))

(define (update-dict file dict)
  (let ((tree (call-with-input-file file
		(lambda (port) (read-mo-file port (current-module))))))
    (fold
     (lambda (defn dict)
       (sx-match defn
	 (((class connector) (ident ,name) . ,_)
	  (acons name defn dict))
	 (else
	  (sf "u missed\n") (pp defn)
	  dict)))
     dict (sx-tail tree))))

(define cnvt #f)

(define (convert-nx-file . args)
  (let* ((options (parse-args args))
	 (files (assoc-ref options 'files))
	 (dict (fold update-dict '() files)))
    (if (assq-ref options 'help) (show-help))
    ;;(sf "files=~S\n" files)
    ;;(sf "dict:\n") (pp dict)
    (and=> (assq-ref options 'gen)
	   (lambda (name)
	     (sf "converting ~S ...\n" name)
	     (cnvt name dict)
	     #f))
    #f))

;; =============================================================================

(use-modules (srfi srfi-11))
(use-modules (sxml match))
(use-modules (sxml fold))		; fold-values

(define keepers '("Real" "Integer" "Boolean" "String"))

;; pars : parameters
;; elts : elements
;; eqns : equations
;; algs : algorithms
(define* (mo-expand-comp pars elts eqns algs dict #:key pd)
  (display "mo-expand-comp\n")
  #f)

  ;; pd : param dict name => value
(define* (mo-expand-decl comp dict #:key pd)
  (sx-match comp
    ((component-clause (type-spec (ident ,tname))
		       (decl (ident ,name) . ,modifier))
     (let ((ty (assoc-ref dict tname))
	   )
       ;;(sf "xdecl:\n") (pp comp)
       ;;(sf " ~S:\n" tname) (pp ty)
       `(a b c)))
    (else
     comp)))

;; in a comp-clause with comp-list, unroll the list
(define (mo-unroll-comp-list cc seed)
  (unless (eq? (sx-tag cc) 'component-clause)
    (error "expecing component-clause"))
  (let loop1 ((head (list (car cc))) (tail (cdr cc)))
    (if (pair? (cdr tail))
	(loop1 (cons (car tail) head) (cdr tail))
	(fold-right
	 (lambda (dtor seed)
	   (cons (reverse (cons dtor head)) seed))
	 seed tail))))

;; expand a class to pars, elts, eqns, and algs
(define* (mo-realize item dict)
  (sx-match item
    (((class model connection) (ident ,name)
      (composition
       (element-list . ,elts)
       (composition-list . ,cmps)))
     (let*-values (((pars elts eqns algs) (mo-break-elt-list elts dict)))
       (newline)
       (sf "pars:\n") (pp pars)
       (sf "elts:\n") (pp elts)
       (values pars elts eqns algs)))
    (else
     (sf "1 missed:\n") (pp item)
     #f)))

;; assume parameter type never has eqns or algs

;;(define (mo-over 

(define (mo-break-elt-list elt-list dict)
  (sf "\n elt-list:\n") (pp elt-list) (newline)
  (fold-values
   (lambda (elt pars elts eqns algs)
     (sx-match elt
       ((extends (ident ,parent))
	(sf "p=~S\n" parent)
	(let ((pval (assoc-ref dict parent)))
	  (unless pval (pp dict) (error "not found"))
	  (call-with-values
	      (lambda () (mo-realize pval dict))
	    (lambda (pas els eqs als)
	      (sf "\nmo-realize=>\n") (pp pas) (pp els)
	      (values (append pas pars) (append els elts)
		      (append eqs eqns) (append als algs))))))
       ((component-clause (type-spec (ident ,t-name)) (comp-list . ,comp-list))
	(let ((elts
	       (fold-right
		(lambda (comp seed)
		  (sf "  comp=~S\n" comp)
		  (sx-match comp
		    ((decl (ident ,v-name))
		     (cons `(comp (type ,t-name) (ident ,v-name)) seed))
		    (else
		     (sf "v missed ~S\n" comp)
		     (cons comp seed))))
		comp-list elts)))
	  (values pars elts eqns algs)))
       ((component-clause
	 (type-prefix "parameter") (type-spec (ident ,t-name))
	 (comp-list . ,comp-list))
	(let ((pars
	       (fold-right
		(lambda (comp seed)
		  (sx-match comp
		    ((decl (ident ,v-name))
		     (cons `(comp (type ,t-name) (ident ,v-name)) seed))
		    (else (cons comp seed))))
		comp-list pars)))
	  (values pars elts eqns algs)))
       (else
	(sf "2 missed:\n") (pp elt)
	(values pars elts eqns algs))))
   elt-list '() '() '() '()))

(set!
 cnvt
 (lambda (name dict)
   (let* ((form (assoc-ref dict name))
	  )
     ;;(pp form)
     (mo-realize form dict)
     #f)))

;; =============================================================================

(apply convert-nx-file (cdr (program-arguments)))

;; ./nxmoelica -g SimpleCircuit x2.mo
;; --- last line ---
