cas_expand_term   xtlang


Defined in:  https://github.com/digego/extempore/tree/v0.8.9/libs/contrib/cas.xtm

Implementation

(bind-func cas_expand_term
  (lambda (t:String*)
    ;; (println "t:" t)
    (set! cas_cntterms (+ cas_cntterms 1))
    (cond ((> cas_cntterms 50) t)
          ((regex_match "^\\(\\(.*\\)\\)$" t)
           (cas_expand_term (trim_brackets t)))
          ((and
            (regex_match "^\\(.*\\)$" t)
            (= 1 (length (find_sexprs t))))
           t)
          ((and
            (regex_match "^\\[.*\\]$" t)
            (= 1 (length (find_sqr_exprs t))))
           (let ((r (regex_split "," (substring t 1 (- (length t) 1)))))
             (if (null? r)
                 (cas_expand_term (substring t 1 (- (length t) 1)))
                 (cat (Str "(vector")
                      (concat (map (lambda (x) (cat (Str " ") (cas_expand_term x))) r))
                      (Str ")")))))
          ((regex_match "^[a-zA-Z]+\\(" t) ;;[^)]*\\)*$" t)
           (let ((matches (regex_matches "\\([^()]*\\)" t))
                 (newt (cas_expand_term (car matches)))
                 (s1 (replace t (car matches) newt))
                 (r1 (regex_replace "^([^(]*).*" s1 "$1"))
                 (r2 (regex_replace "^([^(]*)(\\(+[^)]*\\)+)(.*)" s1 "$2"))
                 (r3 (regex_replace "^([^(]*)(\\(+[^)]*\\)+)(.*)" s1 "$3")))
             ;; (println "s1:" s1 "r1:" r1 "r2:" r2 "r3:" r3)
             (cas_expand_term (cat (Str "(") r1 (Str " ")
                                   (cas_expand_term (trim_brackets r2))
                                   (Str ")") r3))))
          ((regex_match "[^(]/" t)
           (let ((r1 (regex_replace "^(.*)([^(])(/)(.*)$" t "$1$2"))
                 (r2 (regex_replace "^(.*)([^(])(/)(.*)$" t "$4"))
                 (r3 (cat (Str "(/ ")
                          (cas_expand_term (trim r1)) (Str " ")
                          (cas_expand_term (trim r2)) (Str ")"))))
             r3))
          ((regex_match "[^(]\\*" t)
           (let ((r1 (regex_replace "^(.*)([^(])(\\*)(.*)$" t "$1$2"))
                 (r2 (regex_replace "^(.*)([^(])(\\*)(.*)$" t "$4"))
                 (r3 (cat (Str "(* ")
                          (cas_expand_term (trim r1)) (Str " ")
                          (cas_expand_term (trim r2)) (Str ")"))))
             ;; (println "multi:" r1 r2 r3)
             r3))
          ((regex_match "e\\^" t)
           (let ((p (regex_split "e\\^" t)))
             (cat (Str "(exp ") (cas_expand_term (trim (nth p 1))) (Str ")"))))
          ((regex_match "\\^" t)
           (let ((p (regex_split "\\^" t)))
             (cat (Str "(pow ")
                  (cas_expand_term (trim (nth p 0))) (Str " ")
                  (cas_expand_term (trim (nth p 1))) (Str ")"))))
          ((regex_match "^[0-9]*$" t)
           (cat t (Str ".0:double")))
          (else t))))


Back to Index

Similar Entries

  • Casec    xtlang
  • Casech    xtlang
  • Casin    xtlang
  • Casinh    xtlang
  • cas    macro
  • cas-xtm-to-string    scheme
  • cas2sexpr    scheme
  • cas2xtm    xtlang
  • cas2xtm_scm    xtlang
  • cas_parse_terms    xtlang
  • caspp    xtlang
  • casppoff    xtlang
  • casppon    xtlang
  • casq    macro
  • cond-expand    macro
  • cond-expand-runtime    scheme
  • cpBBExpand    xtlang
  • determinant    xtlang
  • expand    macro
  • glfw_terminate    xtlang
  • impc:compiler:print-cannot-expand-non-generic-error    scheme
  • impc:ir:compiler:bitcast    scheme
  • impc:ir:get-type-expand-poly    scheme
  • impc:ti:bitcast-check    scheme
  • impc:ti:expand-generic-type    scheme
  • impc:ti:expand-generic-type-func-gpoly-arity    scheme
  • impc:ti:expand-generic-types    scheme
  • impc:ti:numeric-cast-operator    scheme
  • impc:ti:reify-generic-type-expand    scheme
  • impc:ti:word-downcase    scheme
  • impc:ti:word-upcase    scheme
  • ivl:expand/contract    scheme
  • macro-expand    scheme
  • mdeterminant    xtlang
  • mdeterminant    xtlang
  • pc:expand/contract    scheme
  • scmcas    scheme
  • sexpr2cas    scheme
  • xtmcas    scheme