Commit 5eae8c96 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Merge branch 'master' of github.com:informatimago/nasium-lse

parents ac834156 b76e1c8c
This diff is collapsed.
1* TEST AFFICHER.
10 AFFICHER[/,'AVEC F0.0']
15 AFFICHER[/,'AFFICHAGE ATTENDU : ','([42]42)']
20 AFFICHER[/,'AFFICHAGE OBTENU : ','(',F0.0,')']&P(42)
25 AFFICHER[/,'AVEC U']
30 AFFICHER[/,'AFFICHAGE ATTENDU : ','([42]42)']
35 AFFICHER[/,'AFFICHAGE OBTENU : ','(',U,')']&Q(42)
40 TERMINER
45 PROCEDURE &P(X) LOCAL X
50 AFFICHER['[',F0.0,']']X
55 RESULTAT X
60 PROCEDURE &Q(X) LOCAL X
65 AFFICHER['[',U,']']X
70 RESULTAT X
This diff is collapsed.
0.9998209000000028
\ No newline at end of file
0.9998179000000027
\ No newline at end of file
......@@ -326,7 +326,7 @@ RETURN: EX-OK
(defun main (&optional args)
(handler-case
(progn
(push #P "/usr/local/lib/" cffi:*foreign-library-directories*)
(push #P"/usr/local/lib/" cffi:*foreign-library-directories*)
(setf *program-name* (or (program-name) *default-program-name*))
(setf *options* (make-default-options))
(set-lse-root)
......@@ -336,6 +336,9 @@ RETURN: EX-OK
#+swank
(cond
((typep (stream-output-stream *terminal-io*)
#+#.(cl:if (cl:find-package "SWANK/GRAY") '(:and) '(:or))
'swank/gray::slime-output-stream
#-#.(cl:if (cl:find-package "SWANK/GRAY") '(:and) '(:or))
'swank-backend::slime-output-stream)
'swank-terminal)
((member (getenv "TERM") '("emacs" "dumb")
......
......@@ -1215,12 +1215,12 @@ POST: (and (cons-position c l) (eq c (nthcdr (cons-position c l) l)))
;; known at compilation time.
;; The format specifiers and the expressions are processed in
;; parallel, threfore the following program:
;; parallel, therefore the following program:
;;
;; 10 AFFICHER['(',U,')']&P(42)
;; 10 AFFICHER['(',F0.0,')']&P(42)
;; 11 TERMINER
;; 100 PROCEDURE &P(X)
;; 101 AFFICHER['[',U,']']X
;; 101 AFFICHER['[',F0.0,']']X
;; 102 RESULTAT X
;;
;; should print:
......
......@@ -660,14 +660,8 @@ code ASCII est CO."
Résultat: une chaîne de caractère contenant la représentation du
nombre A au format U."
(let* ((ca (deref *vm* ca))
(ca (un-nombre ca))
(value (abs ca)))
(format nil (cond
((and (<= 1e-3 value) (< value 1e6)) "~A")
(t "~,,2,,,,'EE"))
(if (= ca (truncate ca))
(truncate ca)
ca))))
(ca (un-nombre ca)))
(format nil "~/COM.INFORMATIMAGO.LSE::FMT-U/" ca)))
(defun set-va (va value)
......
......@@ -60,9 +60,10 @@
cl-ppcre::*standard-optimize-settings*
"Don't fuck with me!")
;;; --------------------------------------------------
;;; --------------------------------------------------
(defun quick-reload (&rest systems)
"Delete and reload the ASDF systems."
......@@ -85,6 +86,13 @@
(quicklisp-client:register-local-projects)
;;; --------------------------------------------------
(ql:quickload '("iolib-grovel" "cffi-grovel"))
(unless (find "/usr/local/include/" iolib-grovel::*cc-flags* :test (function string=))
(setf iolib-grovel::*cc-flags* (append iolib-grovel::*cc-flags* (list "-I" "/usr/local/include/"))))
(unless (find "/usr/local/include/" cffi-grovel::*cc-flags* :test (function string=))
(setf cffi-grovel::*cc-flags* (append cffi-grovel::*cc-flags* (list "-I" "/usr/local/include/"))))
;; (defun delete-package-and-users (package)
;; (mapc 'delete-package-and-users (package-used-by-list package))
......
......@@ -105,7 +105,8 @@ DISTRIBUE SELON LES TERMES DE LA LICENCE AGPLv3.
(defun shell-command-to-string (command)
"Execute the COMMAND with asdf:run-shell-command and returns its
stdout in a string (going thru a file)."
(let ((path (format nil "out-~36,8,'0R.txt" (random (expt 2 32)))))
(let ((path (namestring (merge-pathnames (format nil "out-~36,8,'0R.txt" (random (expt 2 32)))
(user-homedir-pathname)))))
(unwind-protect
(when (zerop (asdf:run-shell-command (format nil "~A > ~S" command path)))
(with-output-to-string (out)
......
......@@ -440,7 +440,7 @@ RETURN: vm
(io-carriage-return *task*))
(defun afficher-space (vm rep)
(check-type rep (or (integer 1) nombre identifier named-slot))
(check-type rep (or (integer 1) nombre named-slot))
(let ((rep (round (deref vm rep))))
(when (plusp rep)
(io-format *task* "~VA" rep ""))))
......@@ -449,7 +449,7 @@ RETURN: vm
(io-new-line *task* (deref vm rep)))
(defun afficher-chaine (vm rep val)
(check-type rep (or (integer 1) nombre identifier named-slot))
(check-type rep (or (integer 1) nombre named-slot))
(check-type val chaine)
(io-format *task* "~A"
(with-output-to-string (out)
......@@ -473,19 +473,18 @@ RETURN: vm
:for i :below (length value)
:initially (afficher-newline vm 1)
:do (if (functionp ctrl)
(progn (funcall ctrl vm (aref value i))
(io-format *task* " "))
(io-format *task* "~? " ctrl (list (aref value i))))))
(funcall ctrl vm (aref value i))
(io-format *task* ctrl (aref value i)))))
(array
(loop
:for i :below (array-dimension value 0)
:initially (afficher-newline vm 1)
:do (loop
:for j :below (array-dimension value 1)
:initially (afficher-newline vm 1)
:do (if (functionp ctrl)
(progn (funcall ctrl vm (aref value i j))
(io-format *task* " "))
(io-format *task* "~? " ctrl (list (aref value i j)))))))))
(funcall ctrl vm (aref value i j))
(io-format *task* ctrl (aref value i j)))
:finally (afficher-newline vm 1))))))
(defun afficher-e (vm val e d)
......@@ -495,27 +494,56 @@ RETURN: vm
(afficher-with-format vm ctrl val)))
(defun fmt-f (stream value colon atsign &optional (width 0) (decimals 0))
"
F2.0 -> ~2,0/fmt-f/
F3.2 -> ~5,2/fmt-f/
"
(declare (ignore colon atsign))
(if (zerop decimals)
(format stream "~VD" width (round value))
(format stream "~V,VF" width decimals value))
(values))
(defun afficher-f (vm val e d)
(let* ((val (deref vm val))
(w (+ e 1 d))
(ctrl (format nil "~~~A,~AF" w d)))
(w (+ e (if (plusp d) 1 0) d))
(ctrl (with-standard-io-syntax
(let ((*package* (load-time-value (find-package :keyword))))
(format nil "~~~A,~A/~S/" w d 'fmt-f)))))
(afficher-with-format vm ctrl val)))
(defun fmt-u (stream value colon atsign)
"
U -> ~/fmt-u/
"
(declare (ignore colon atsign))
(etypecase value
((or integer nombre)
(let ((mag (abs value)))
(format stream (if (or (zerop mag)
(and (<= 1e-3 (abs mag)) (< (abs mag) 1e6)))
"~A"
"~,,2,,,,'EE")
;; convert to integer when there's no significant decimal digit:
(let ((tvalue (truncate value)))
(if (= tvalue value)
tvalue
value)))))
(string
(format stream "~A" value)))
(values))
(defun afficher-u (vm value)
(let ((value (deref vm value)))
(etypecase value
((or integer nombre)
(io-format *task* (if (or (zerop value)
(and (<= 1e-3 (abs value)) (< (abs value) 1e6)))
"~A "
"~,,2,,,,'EE ")
(let ((tvalue (truncate value)))
(if (= tvalue value)
tvalue
value))))
(io-format *task* "~/COM.INFORMATIMAGO.LSE::FMT-U/ " value))
(chaine
(io-format *task* "~A" value))
(io-format *task* "~A" value))
((or vector array)
(afficher-with-format vm (function afficher-u) value)))))
......@@ -1574,7 +1602,6 @@ Voir: FAIREJUSQUA, FAIRETANTQUE"
#||
references:
......
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