[racket] Problem around Creating Excutables
I see it may be a bug.
I don't know if I put the code here or not, but determine to put it.
Note that this is a kind of messy code and I mean it. It is a sort of
experiment.
I try making a REPL structure with Data Driven Programming way that might
be implied in SICP using closures, a bit close to OOP without inheritance.
The first purpose the reason I write in this messy way is that I want to
know "Functional Programming" on Scheme is "Obviously" better
and simpler than "OOP style"; therefore, the code shown here looks like
"Awful!-This-is-not-a-Scheme-code-you-mor*n!" style.
However, the second purpose is, more impotant, more than letting me got
accustomed to OOP way, that I thought MVC pattern which is occasionally
used in GUI programming is very close to REPL structure and it may imply if
you wrote an completely-isolated R-E-P-L style CLI program, you may easily
convert into the GUI one by inheritance with some GUI tool kit like Qt or
WxWidgets.
These are why I decided to write an awful OOP-like code on Scheme.
--------
#lang racket
;;;;; Tofu Sellers in Iscandar (Version Scheme)
;;;;; Copyright (C) 1978-2014 by N.Tsuda
;;;;; http://vivi.dyndns.org/tofu/tofu.html
;;;;; was made on PLT Racket
;;;;; Racket:
;;;;; http://racket-lang.org/
; This section relies on Racket.
; If you use another scheme implimentation,
; you've got to rewrite below one in each way
; such as:
; Gauche: http://practical-scheme.net/gauche/index-j.html
; (use srfi-1) ...
; Guile: http://www.gnu.org/software/guile/
; (srfi srfi-1) ...
; and so on.
; Please refer to the paticular reference.
(require srfi/1 srfi/11 srfi/13 srfi/27)
; These codes here rely on Racket.
; To set character code on Windows especially for Japanese One.
(current-input-port (reencode-input-port (current-input-port)
"shift_jis"))
(current-output-port (reencode-output-port (current-output-port)
"shift_jis"))
;;; Initialize random number source
(random-source-randomize! (make-random-source))
;;; Macros for Data Driven Programming
;;; Psedo Object Orientated Programming
;;; Inspired by the code on PAIP
;;; PAIP : http://norvig.com/paip.html
;;; , written by Peter Norvig.
;; Associate list for Generic Procedures
(define generic-proc '())
;; Associate list for Class Variables
(define class-vars-alist '())
;; Macro for defining classes
(define-syntax define-class
(syntax-rules ()
((_ class (inst-var ...)
((class-var class-val) ...)
(method arg body ...) ...)
(begin
(set! class-vars-alist
(cons `(class ((class-var . ,class-val) ...))
class-vars-alist))
(for-each ensure-generic-proc '(method ...))
(define (class inst-var ...)
(lambda (message)
(case message
((method) (lambda arg body ...))
...)))))))
(define (get-method object message)
(object message))
(define (ensure-generic-proc message)
(if (assq message generic-proc)
#f
(let ((proc (lambda (object . args)
(apply (get-method object message) args))))
(set! generic-proc
(alist-cons message proc generic-proc)))))
(define-syntax get-class-var
(syntax-rules ()
((_ class var)
(cdr (assq 'var
(cadr (assq 'class class-vars-alist)))))))
(define-syntax class-var-set!
(syntax-rules ()
((_ class var val)
(let ((alist
(alist-cons 'var val
(alist-delete 'var
(cadr (assq 'class
class-vars-alist))))))
(set! class-vars-alist
(cons `(class ,alist)
(alist-delete 'class class-vars-alist)))))))
;; Macro for defining method
(define-syntax define-method
(syntax-rules ()
((_ method)
(define method (cdr (assq 'method generic-proc))))))
;;; Test codes for macros of defining classes
;;; These are borrowed from PAIP,
;;; Paradigms of Artificial Intelligence Programming
;
;(define-class account (name (balance 0))
; ((interest-rate .06))
; (withdraw (amt) (cond ((<= amt balance)
; (set! balance (- balance amt))
; balance)
; (else 'insufficient-funds)))
; (deposit (amt) (set! balance (+ balance amt))
; balance)
; (balance () balance)
; (name () name)
; (interest () (set! balance
; (+ balance (* (get-class-var account interest-rate)
balance)))
; balance))
;
;(define-method withdraw)
;(define-method deposit)
;(define-method balance)
;(define-method name)
;(define-method interest)
;
;class-vars-alist
;generic-proc
;
;(define acct (account "A. User" 2000))
;(= (deposit acct 42) 2042)
;(= (interest acct) 2164.52)
;(= (balance acct) 2164.52)
;;; Parser Class (Read)
;; This is the Read section on REPL, or an interpreter model.
;; In the case of programming a game, deffering from the ordinary
;; Read section of an interpreter, games' Read function sometimes
;; got to change its behavior.
;; In this game, the game stage, reffering as "phase" in this
;; program, implimented as class variable, requires the Read to
;; behave three different ways, such as "Nothing-Inputted-but-returns
;; -something-to-eval", "Requires-input-only-integer-and-returns-
;; something-to-eval",and "Requires-input-only-yes-or-no-like-and-
;; returns-something-to-eval".
;; This mentioned above is the guide to program 'EVAL' here in
;; this program.
;; By the way, this Read class always returns two variables, the first
;; one is phase as a Symbol and the second one is either input or #f
;; by using "values" of Scheme.
(define-class parser ()
; Initial state of its class variable,
; "phase" is 'introduction
((phase 'introduction))
; input method
(input () (let-syntax ((return-values
(syntax-rules ()
((_ phase proc0 (proc1))
(values phase (let loop ((i (proc1)))
(let ((fact (proc0 i)))
(if (null? fact)
(loop (proc1))
fact))))))))
(letrec ((input-integer
; Letting it being able to receive
; only integers from input.
; If not, returns an empty list.
(lambda (var)
(if (integer? var)
var
'())))
(yes-or-no?
; Letting it being able to receive only
; 'yes', 'no' or its-alikes.
; If not, returns an empty list.
; Trying emulating a Common Lisp
; function "YES-OR-NO-P".
(lambda (var)
(letrec ((y-or-n?
; Returning #t if the input
; were yes-likes.
; Returning #f if the input
; were no-likes.
(lambda (sym)
(and (memq sym '(Y YES)) #t)))
(symbol-upcase
; Converting the symbol inputted
; into Upper-Case.
(lambda (arg)
(if (symbol? arg)
(string->symbol
(string-upcase
(symbol->string arg)))
'()))))
(let ((sym (symbol-upcase var)))
(if (memq sym '(Y YES N NO))
(y-or-n? sym)
'()))))))
; body
(let ((p (get-class-var parser phase)))
(case p
((input-integer)
(return-values p input-integer (read)))
((instruction play-again?)
(return-values p yes-or-no? (read)))
(else (values p #f))))))))
(define-method input)
;;; Test codes for the Parser Class
;
;(define p (parser))
;class-vars-alist
;(class-var-set! parser phase 'input-integer)
;(input p)
;(class-var-set! parser phase 'instruction)
;(input p)
;(class-var-set! parser phase 'play-again)
;(input p)
;(class-var-set! parser phase 'foo)
;(input p)
;;; Player Class
;; This section defines the class for you,
;; or player of this game.
(define-class player ((money 5000) (tofu 0))
()
(money () money)
(money-set! (arg) (set! money arg))
(show-tofu () tofu)
(make-tofu (num env) (let ((maxnum
(maximum (get-tofu env) (get-player env))))
(if (> num maxnum)
(set! tofu maxnum)
(set! tofu num))
tofu)))
;;; Computer Class
;; This is the class for your opponent, computer.
(define-class computer ((money 5000) (tofu 0))
()
(money () money)
(money-set! (arg) (set! money arg))
(show-tofu () tofu)
(make-tofu (env) (letrec ((calc
(lambda (num)
(let ((maxnum
(quotient money (cost (get-tofu
env)))))
(if (> num maxnum)
maxnum
num)))))
(cond ((> (cdr
(assq 'rainy
(weather-report (get-weather env))))
30)
(set! tofu
(is-rainy (get-tofu env))))
((> (cdr
(assq 'sunny
(weather-report (get-weather env))))
49)
(set! tofu (calc (is-sunny (get-tofu env)))))
(else
(set! tofu (calc (is-cloudy (get-tofu env))))))
tofu)))
(define-method money)
(define-method money-set!)
(define-method show-tofu)
(define-method make-tofu)
;;; Tofu Class
;; Yes, SOY-BEAN-CURD!!!
;; Nothing to explain...
;; Oh, you've never eaten it?
;; Go to a Japanese restaurant
;; in or near your town...
;;
http://www.amazon.co.jp/%E6%A3%AE%E6%B0%B8%E4%B9%B3%E6%A5%AD-%E7%B5%B9%E3%81%94%E3%81%97%E3%81%A8%E3%81%86%E3%81%B5-290g-24%E5%80%8B%E5%85%A5/dp/B001LGM4UG
(define-class tofu ((cost 40)
(price 50)
(sunny 500)
(cloudy 300)
(rainy 100))
()
(cost () cost)
(price () price)
(is-sunny () sunny)
(is-cloudy () cloudy)
(is-rainy () rainy)
(maximum (player) (quotient (money player) cost)))
(define-method cost)
(define-method price)
(define-method is-sunny)
(define-method is-cloudy)
(define-method is-rainy)
(define-method maximum)
;;; Weather Class
;; How many tofus could be sold relies on weather in this game.
;; This weather class controls all related to weather.
;; This calculates weather report by using random number provided
;; from SRFI-27. It also calculates the actual weather.
(define-class weather ((sunny 0)
(cloudy 0)
(rainy 0))
()
; Calculating the weather report
(calc-weather-report () (let ((prob0 (random-integer 100))
(prob1 (random-integer 100)))
(cond ((> prob0 prob1)
(set! sunny (- 100 prob0))
(set! rainy prob1))
(else (set! sunny (- 100 prob1))
(set! rainy prob0)))
(set! cloudy (- 100 sunny rainy))))
; Returning the weather report as an associate list
(weather-report () `((sunny . ,sunny)
(cloudy . ,cloudy)
(rainy . ,rainy)))
; Returning actual weather next day
(actual-weather () (let ((r (random-integer 100)))
(cond ((<= r rainy) (values is-rainy 'rainy))
((<= r (+ rainy cloudy)) (values is-cloudy
'cloudy))
(else (values is-sunny 'sunny))))))
(define-method calc-weather-report)
(define-method weather-report)
(define-method actual-weather)
;;; Environment class
;; As same as an ordinary REPL, the Eval section
;; refers an environment to get variable, state, or
;; information of the game such as how much money
;; the player has and so on.
;; The Environment Class packs the information of
;; the player, computer, tofu, weather defined as
;; classes above and the target amount of money to the
;; game-over as its instance variables, and the Eval
;; section accsesses to these.
(define-class environment ((p (player))
(c (computer))
(t (tofu))
(w (weather))
(game-over 30000))
()
(get-player () p)
(player-set! (arg) (set! p (arg)))
(get-computer () c)
(computer-set! (arg) (set! c (arg)))
(get-tofu () t)
(get-weather () w)
(get-game-over () game-over))
(define-method get-player)
(define-method player-set!)
(define-method get-computer)
(define-method computer-set!)
(define-method get-tofu)
(define-method get-weather)
(define-method get-game-over)
;;; Test codes for the Environment Class
;
;(define e (environment))
;(define method-list `(,money ,show-tofu))
;(map (lambda (x)
; (x (get-player e)))
; method-list)
;(map (lambda (x)
; (x (get-computer e)))
; method-list)
;(define tofu-proplist
; `(,price ,cost ,is-sunny ,is-rainy ,is-cloudy))
;(map (lambda (x)
; (x (get-tofu e)))
; tofu-proplist)
;(get-game-over e)
;;; Game Master Class (Eval)
;; The Game-Master Class is simply EVAL in the
;; REPL intepreter. It calclates results according
;; to the arguments coming from the READ, setting
;; the next-phase on the class variable "phase"
;; on the Read Class, and returns the calculated
;; results to the Print Class.
;; As long as the ordinary interpreter like Scheme,
;; this is the heart of system.
;; By the way, this Eval class always returns two
;; variables, the first one is "what-to-show" as
;; a Symbol and the second one is the information
;; calculated if needed by the Print section or #f,
;; by using "values" of Scheme.
(define-class game-master ((env (environment))
(strange-flag #t))
()
(interp (x y) (letrec ((instruction
; Evaluating "instruction of this game"
(lambda (x env)
(cond ((eq? x strange-flag)
(set! strange-flag #f)
(values 'instruction #f))
(else (class-var-set! parser phase
'input-integer)
(calc-weather-report (get-weather
env))
(values 'show-data env)))))
(calculation
; Evaluating "how mamy tofus are sold and income
nextday"
(lambda (x fact env)
(let ((sold (if (> (show-tofu x) fact)
fact
(show-tofu x))))
(let ((money
(- (+ (money x)
(* sold (price (get-tofu env))))
(* (show-tofu x) (cost (get-tofu
env))))))
(money-set! x money)))))
(test-who-is-winner
; Evaluationg "Who is the winner?"
(lambda (env)
(letrec ((test
; Calculationg if the game is over or
not
(lambda (env)
(or (>= (money (get-player env))
(get-game-over env))
(>= (money (get-computer env))
(get-game-over env))
(< (money (get-player env))
(cost (get-tofu env)))
(< (money (get-computer env))
(cost (get-tofu env))))))
(who-is-winner
; Determing who is the winner in the
turn
(lambda (env)
(cond ((> (money (get-player env))
(money (get-computer
env)))
'you-win)
((< (money (get-player env))
(money (get-computer
env)))
'you-lose)
(else 'even)))))
(cond ((test env) (class-var-set! parser
phase 'play-again?)
(values 'who-is-winner
(who-is-winner env)))
(else (class-var-set! parser phase
'input-integer)
(calc-weather-report (get-weather
env))
(values 'show-data env))))))
(play-again?
; Asking continue? after the game-over of the turn
(lambda (x env)
(cond (x (class-var-set! parser phase
'input-integer)
(player-set! env player)
(computer-set! env computer)
(calc-weather-report (get-weather env))
(values 'show-data env))
; Both procedures here rely on Racket.
; If you use another implimentation,
please
; refer to its manual.
; Unfortunately, the specification of
Scheme
; (R5RS) does not define "exit" or "quit"
to
; quit the scheme system.
(else (flush-output)
(exit))))))
; body
(case x
((introduction) (class-var-set! parser phase
'instruction)
(values x #f))
((instruction) (instruction y env))
((input-integer) (class-var-set! parser phase 'next-day)
(make-tofu (get-player env) y env)
(let ((num (make-tofu (get-computer
env) env)))
(values 'opponent-turn num)))
((next-day) (class-var-set! parser phase 'test)
(let-values (((method sym) (actual-weather
(get-weather env))))
(let ((fact (method (get-tofu env))))
(for-each (lambda (x)
(calculation x fact env))
`(,(get-player env)
,(get-computer env)))
(values x sym))))
((test) (test-who-is-winner env))
((play-again?) (play-again? y env))))))
(define-method interp)
;;; test codes for the Game Master Class
;
;(define g (game-master))
;class-vars-alist
;(interp g 'introduction #t)
;class-vars-alist
;(interp g 'instruction #t)
;class-vars-alist
;(interp g 'instruction #t)
;class-vars-alist
;(interp g 'input-integer 100)
;class-vars-alist
;(interp g 'next-day #f)
;class-vars-alist
;(interp g 'test #f)
;;; Message Class (Print)
;; The Message Class is simply the Print in the ordinary REPL
;; interpreter like Scheme. It only calculates in order to
;; format texts to display; however, it never calculates something
;; related to the game's process itself. I try making completedly
;; isolating functions for each classes of REPL. As a result, the
;; Message class got to have a bunch of something to display like
;; strings as data inside it.
(define-class message ((data '((introduction . "イスカンダルのトーフ屋ゲーム (scheme版) \n
The Tofu Sellers in Iscandar for Scheme
Copyright (C) 1978-2014 by N.Tsuda\n
ルール説明しますか?[y/n]\n
Do you want to see the instruction?[y/n]")
(instruction . "ここはイスカンダル星。あなたはここでトーフ屋を経営し、\n
This is the Planet Iscandar. You've got to manage a Tofu(Soy bean curd)
shop\n
地球への帰還費用を作り出さなくてはいけません。\n
and earn money to go back to the Earth.\n
でもお向かいには、コンピュータが経営するトーフ屋があります。。。\n
However, you see another Tofu shop a computer manages across the street.\n
\n
トーフの原価は1個40円、販売価格は50円です。\n
The cost to make a Tofu is 40yen and its price is 50yen.\n
1日に売れる個数は天候に左右されます。\n
The number you could sell tofus in a day depends on the weather.\n
トーフは日持ちしないので、売れ残った分はすべて廃棄します。\n
You can not keep Tofus for long and let them be as dead stock(Dispose
them!).\n
そこで、次の日の天気予報を良く見て、何個作るか決心してください。\n
Therefore, you have carefully got to see the wether report and decide how
many tofus to make.\n
所持金5千円からはじめて早く3万円を超えた方が勝ちです。\n
You initially have 5000yen and the winner would be the one to have more
than 30000yen earlier.\n
\n
いいですか?[y/n]
Alrignt?[y/n]")
(1000-yen . #\■)
(empty-yen . #\□)
(next-day . "\n***** 次の日(The Next Day)
*****\n")
(weather-is . "今日の天気は(Today's weather is")
(result . " です。\n")
(sunny . (#\◎ . "晴れ \\(^o^)/ SUNNY "))
(cloudy . (#\・ . "くもり (~_~) CLOUDY "))
(rainy . (#\● . "雨 (;_;) RAINY"))
(you-win . "あなたの勝ちです。\nYOU WIN!\n\n")
(even . "引き分けです。\nEVEN\n\n")
(you-lose . "コンピュータの勝ちです。\nCOMPUTER
WINS!\n\n")
(play-again? . "play again? [y/n]"))))
()
(print (x y)
(letrec ((show-data
; Showing the data of current condition
(lambda (env)
(letrec ((show-money
; Showing the money the player and the
computer have
(lambda ()
(letrec ((calc
; Calculating to format the text
to show
(lambda (player)
(letrec ((space-calc
(lambda (x)
(cond ((> x 9999)
"")
((> x 999) "
")
((> x 99) "
")
(else "
")))))
(let ((x (money player)))
(let ((y (quotient x
1000)))
(values (space-calc x)
(number->string
x)
(make-string y
(cdr (assq '1000-yen data)))
(make-string (-
30 y)
(cdr (assq 'empty-yen data))))))))))
(let-values (((p0 p1 p2 p3) (calc
(get-player env))))
(let-values (((c0 c1 c2 c3) (calc
(get-computer env))))
(string-append "\n所持金(MONEY):
\nあなた(YOU) "
p0 p1 "円(YEN) " p2 p3
"\nわたし(COM) "
c0 c1 "円(YEN) " c2 c3
"\n\n"))))))
(show-weather-report
; Showing the weather report
(lambda ()
(letrec
((calc
; Calculating to format texts to show
(lambda ()
(let ((wr (weather-report
(get-weather env)))
(keys '(sunny cloudy rainy)))
(let ((table (map (lambda (x)
`(,x .
,(quotient (* 40 (cdr (assq x wr))) 100)))
keys)))
(append (map (lambda (x)
(number->string
(cdr (assq x wr))))
keys)
(map (lambda (x)
(make-string
(cdr (assq x table)) (cadr (assq x data))))
keys)))))))
(let ((string-list (calc)))
(string-append "明日の天気予報(WEATHER
REPORT): 晴れ(SUNNY) "
(list-ref string-list 0)
"% くもり(CLOUDY) "
(list-ref string-list 1)
"% 雨(RAINY) "
(list-ref string-list 2)
"%\n"
(list-ref string-list 3)
(list-ref string-list 4)
(list-ref string-list 5)
"\n\n")))))
(show-howmany-tofus
; Showing to ask how many tofus to make
(lambda ()
(string-append "\nトーフを何個作りますか?(HOW MANY
TOFUS TO MAKE?) (1~"
(number->string
(maximum (get-tofu env)
(get-player env)))
") "))))
(string-append (show-money)
(show-weather-report)
(show-howmany-tofus)))))
(show-computer-reply
; Showing the decision of the computer
(lambda (num)
(string-append "わたしは(COMP MAKES)"
(number->string num)
"個作ります。\n")))
(show-result
; Showing how many tofus are sold next day
(lambda (sym)
(string-append
(cddr (assq sym data))
(cdr (assq 'result data))))))
(for-each (lambda (x)
; "sleep" relies on Racket.
; If you use another implementation
; letting you use SRFI-18, you can
; use "thread-sleep" insted.
; Anyway, refer to the manual of
; implementation you use.
(sleep 0.5)
(display x))
(case x
((show-data) `(,(show-data y)))
((opponent-turn) `(,(show-computer-reply y)))
((next-day) `(,(cdr (assq 'next-day data))
,(cdr (assq 'weather-is data))
"." "." "."
,(show-result y)))
((who-is-winner) (map (lambda (z)
(cdr (assq z data)))
`(,y play-again?)))
(else `(,(cdr (assq x data)))))))))
(define-method print)
;;;; test codes for the Massage Class
;
;(define p (message))
;(define e (environment))
;(print p 'introduction #f)
;(print p 'instruction #t)
;(print p 'instruction #f)
;(print p 'show-data e)
;(print p 'opponent-turn (make-tofu (get-computer e) e))
;(print p 'next-day 'sunny)
;(print p 'next-day 'cloudy)
;(print p 'next-day 'rainy)
;;; REPL
(define (repl)
(let ((r (parser))
(e (game-master))
(p (message)))
(let loop ()
(let-values (((phase0 info0) (input r)))
(let-values (((phase1 info1) (interp e phase0 info0)))
(print p phase1 info1)))
(loop))))
(repl)
2014/1/3 Pierpaolo Bernardi <olopierpa at gmail.com>
> On Thu, Jan 2, 2014 at 4:09 PM, 亀田馬志 <masashi.kameda at gmail.com> wrote:
>
> > Is this O.K? or do I have to put (flush-output) every time after
> (display)?
>
> without flush-output what you write in the stream remains in a buffer
> and is actually written out only when the buffer is full. You must use
> flush-output when you want to be sure that what you wrote is actually
> displayed on the screen, for example, before reading a string from the
> user.
>
> If you define your own print and read functions, as in the snippet
> above, you can put the flush-output in them.
>
> > The second question is... The game I compiled is, after shown several
> > processes I made, got Abend, though running on Racket Interpreter is
> fine.
> > What is the reason of this? Do I have to put something like
> > (current-input-port)
> > stuff?
>
> If you use no foreign code, probably this indicates that there's a bug
> in Racket that only the developers can address. And they will need a
> way to reproduce the crash, to look at it.
>
> Cheers
> P.
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20140103/f3bf7ca8/attachment-0001.html>
![[logo]](/logo.png){kind=logo}