char_conversion directive added, bug in char_conversion fixed

parent 128405d9
......@@ -14,8 +14,7 @@
compile-string compile-file save-operator-table prolog-run
load-prolog clear-directives
init-char-conversion
save-character-conversion
save-char-conversion-table
;; Math
sin cos atan exp log sqrt
......
......@@ -5,8 +5,9 @@
#:use-module (logic guile-log)
#:export
(init-char-conversion char-convert char-conversions->assq
save-char-conversion-table
assq->char-conversions char_conversion
save-character-conversion do-character-convert
do-character-convert
current_char_conversion init-char-conversion))
(define *conversion* (make-fluid vlist-null))
......@@ -50,12 +51,10 @@
(lp (cdr a) (vhash-consq (caar a) (cdar a) vhash))
(fluid-set! *conversion* vhash))))
(define-syntax save-character-conversion
(define-syntax save-char-conversion-table
(lambda (x)
(syntax-case x ()
((_)
#`(assq->char-conversions
'(#,(char-conversions->assq)))))))
#`(assq->char-conversions
'#,(datum->syntax #'define (char-conversions->assq)))))
(define (add-char-conversion ch1 ch2)
......@@ -100,15 +99,13 @@
((not ch2-)
(representation_error character))
(else
(<code> (add-char-conversion ch1 ch2))))))))
(<code> (add-char-conversion ch1- ch2-))))))))
(<define> (current_char_conversion ch1 ch2)
(<let> ((ch1- (->ch (<lookup> ch1)))
(ch2- (->ch (<lookup> ch2))))
(<let*> ((ch1 (<lookup> ch1))
(ch1- (->ch ch1))
(ch2- (->ch (<lookup> ch2))))
(cond
((not ch1-)
(representation_error character))
((<var?> ch1)
(<let> ((ch2 (if (<var?> ch2) ch2 ch2-)))
(cond
......@@ -126,12 +123,15 @@
(lp l)))
(() (<cut> <fail>))))))))
((not ch1-)
(representation_error character))
(else
(<let> ((ch2* (char-convert ch1-)))
(cond
((not ch2-)
(representation_error character))
((<var?> ch2)
(<=> ch2 ,(<-ch ch2*)))
((not ch2-)
(representation_error character))
(else
(<=> ch2- ch2*))))))))
\ No newline at end of file
......@@ -12,7 +12,9 @@
atom integer number fail true
))
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log prolog dynamic)
#:use-module (logic guile-log prolog char-conversion)
#:use-module (logic guile-log prolog load)
#:use-module (logic guile-log prolog parser)
#:use-module (logic guile-log prolog run)
......@@ -239,6 +241,8 @@
(_ (format #t "COMPILE ERROR: Bad op/3 directive at (~a,~a)~%" M N) #t)))
(define-parser-directive-onfkn ensure_loaded (op-spc stx l N M)
(match l
((#:string str _ _)
......@@ -247,6 +251,23 @@
#`(load (ensure_loaded_ #,(symbol->string atm))))
(_ (format #t "COMPILE ERROR: Bad ensure_loaded/1 directive at (~a,~a)~%" M N) #t)))
(define (str x)
(cond
((symbol? x)
(symbol->string x))
(else
x)))
(define-parser-directive-onfkn char_conversion (char_conv_directive stx l N M)
(match l
(((_ _ "," _)
(or (#:string a _ _) (#:symbol a _ _))
(or (#:symbol b _ _) (#:string b _ _)) _ _)
#`(char_conversion (fluid-ref *current-stack*)
(lambda x #f) (lambda x #t) #,(str a) #,(str b)))
(_
(format #t "COMPILE ERROR: Bad character format in char_conversion at (~a:~a)~%" M N))))
(<define> (local_initialization) <cc>)
(define (initialization . x)
(error "initializattion is not for dynamic evaluation"))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment