開発環境
- macOS Sierra - Apple (OS)
- Emacs (Text Editor)
- C, Scheme (プログラミング言語)
- Clang/LLVM (コンパイラ, Xcode - Apple)
- 参考書籍等
Cを高級アセンブラーとした、Scheme の コンパイラー(ksc)、インタプリター(ksi)の作成での、手続きの引数の型、長さのエラー検出の方針を決める。
なんとなく漠然と書いたコードを、少しずつ綺麗にしたり、とりあえず必要な手続きを追加していく中で、手続きの引数の型、長さのエラーの検出方法を決める。
- C言語側で書く手続きでは引数の型のチェック、長さのチェックは行わない。
- Scheme のproc-name という手続きをC言語側書く場合、c-proc-name という名前にする。
- Scheme 側でc-proc-name という手続きを使って、引数の型のチェック、長さのチェックを行う手続き proc-name を記述する。
- ksc(コンパイラ)では C言語側で書いた error 手続きを使う。エラーが発生したら終了させる。(C言語のexit関数)
- ksi(インタプリンタ)では、Scheme 側で error 手続きを上書きして、エラーが発生しても終了させるのではなく、エラーオブジェクトを伝搬させて、エラーを印字、再び read-eval-print-loop の read に戻るようにする。
とりあえずはこの方針で、必要な手続き(C言語側、Scheme 側)を少しずつ追加していくことに。
コード
primitive_procedures.scm
(begin
(define (* . args)
(define (iter zs result e?)
(if (c-null? zs)
result
((lambda (z)
(if (c-number? z)
(if (and e? (c-exact? z))
(iter (c-cdr zs)
(c-* result z)
e?)
(iter (c-cdr zs)
(c-* (c-inexact result) (c-inexact z))
#f))
(error '|(*) wrong type of argument --| args)))
(c-car zs))))
(iter args 1 #t))
(define (+ . args)
(define (iter zs result e?)
(if (c-null? zs)
result
((lambda (z)
(if (c-number? z)
(if (and e? (c-exact? z))
(iter (c-cdr zs)
(c-+ result z)
e?)
(iter (c-cdr zs)
(c-+ (c-inexact result) (c-inexact z))
#f))
(error '|(+) wrong type of argument --| args)))
(c-car zs))))
(iter args 0 #t))
(define (- . args)
(define len (c-length args))
(if (c-= len 0)
(error '|(-) wrong number of arguments --| args)
(if (c-= len 1)
(if (c-number? (c-car args))
(if (c-exact? (c-car args))
(c-* -1 (c-car args))
(c-* (c-inexact -1) (c-car args)))
(error '|(-) wrong type of argument --| args))
(begin
(define (iter nums result e?)
(if (c-null? nums)
result
(if (c-number? (c-car nums))
(if (and e? (c-exact? (c-car nums)))
(iter (c-cdr nums)
(c-- result (c-car nums))
#t)
(iter (c-cdr nums)
(c-- (c-inexact result)
(c-inexact (c-car nums)))
#f))
(error '|(-) wrong type of argument --| args))))
(iter (c-cdr args) (c-car args) (c-exact? (c-car args)))))))
(define (/ . args)
(define len (c-length args))
(if (c-= len 0)
(error '|(/) wrong number of arguments --| args)
(if (c-= len 1)
(if (c-number? (c-car args))
(if (c-exact? (c-car args))
(c-/ 1 (c-car args))
(c-/ (c-inexact 1) (c-car args)))
(error '|(/) wrong type of argument --| args))
(begin
(define (iter nums result e?)
(if (c-null? nums)
result
(if (c-number? (c-car nums))
(if (and e? (c-exact? (c-car nums)))
(if (c-= (c-car nums) 0)
(error '|(/) division by zero --| args)
(iter (c-cdr nums)
(c-/ result (c-car nums))
#t))
(iter (c-cdr nums)
(c-/ (c-inexact result)
(c-inexact (c-car nums)))
#f))
(error '|(/) wrong type of argument --| args))))
(iter (c-cdr args) (c-car args) (c-exact? (c-car args)))))))
(define (< . args)
(define len (c-length args))
(if (c-< len 2)
(error '|(<) wrong number of arguments --| args)
(begin
(if (c-real? (c-car args))
(begin
(define (cmp x y)
(if (and (c-exact? x) (c-exact? y))
(c-< x y)
(c-< (c-inexact x) (c-inexact y))))
(define (iter x xs)
(if (c-null? xs)
#t
(if (c-real? (c-car xs))
(if (cmp x (c-car xs))
(iter (c-car xs) (c-cdr xs))
#f)
(error '|(<) wrong type of argument --| args))))
(iter (c-car args) (c-cdr args)))
(error '|(<) wrong type of argument --| args)))))
(define (<= . args)
(define len (c-length args))
(if (c-< len 2)
(error '|(<=) wrong number of arguments --| args)
(begin
(if (c-real? (c-car args))
(begin
(define (cmp x y)
(if (and (c-exact? x) (c-exact? y))
(or (c-= x y) (c-< x y))
(or (c-= (c-inexact x) (c-inexact y))
(c-< (c-inexact x) (c-inexact y)))))
(define (iter x xs)
(if (c-null? xs)
#t
(if (c-real? (c-car xs))
(if (cmp x (c-car xs))
(iter (c-car xs) (c-cdr xs))
#f)
(error '|(<=) wrong type of argument --| args))))
(iter (c-car args) (c-cdr args)))
(error '|(<=) wrong type of argument --| args)))))
(define (= . args)
(define len (c-length args))
(if (c-< len 2)
(error '|(=) wrong number of arguments --| args)
(begin
(if (c-number? (c-car args))
(begin
(define (cmp x y)
(if (and (c-exact? x) (c-exact? y))
(c-= x y)
(c-= (c-inexact x) (c-inexact y))))
(define (iter x xs)
(if (c-null? xs)
#t
(if (c-number? (c-car xs))
(if (cmp x (c-car xs))
(iter (c-car xs) (c-cdr xs))
#f)
(error '|(=) wrong type of argument --| args))))
(iter (c-car args) (c-cdr args)))
(error '|(=) wrong type of argument --| args)))))
(define (> . args)
(define len (c-length args))
(if (c-< len 2)
(error '|(>) wrong number of arguments --| args)
(begin
(if (c-real? (c-car args))
(begin
(define (cmp x y)
(if (and (c-exact? x) (c-exact? y))
(c-< y x)
(c-< (c-inexact y) (c-inexact x))))
(define (iter x xs)
(if (c-null? xs)
#t
(if (c-real? (c-car xs))
(if (cmp x (c-car xs))
(iter (c-car xs) (c-cdr xs))
#f)
(error '|(>) wrong type of argument --| args))))
(iter (c-car args) (c-cdr args)))
(error '|(>) wrong type of argument --| args)))))
(define (>= . args)
(define len (c-length args))
(if (c-< len 2)
(error '|(>=) wrong number of arguments --| args)
(begin
(if (c-real? (c-car args))
(begin
(define (cmp x y)
(if (and (c-exact? x) (c-exact? y))
(or (c-= x y) (c-< y x))
(or (c-= (c-inexact x) (c-inexact y))
(c-< (c-inexact y) (c-inexact x)))))
(define (iter x xs)
(if (c-null? xs)
#t
(if (c-real? (c-car xs))
(if (cmp x (c-car xs))
(iter (c-car xs) (c-cdr xs))
#f)
(error '|(>=) wrong type of argument --| args))))
(iter (c-car args) (c-cdr args)))
(error '|(>=) wrong type of argument --| args)))))
(define (abs . args)
(if (c-= (c-length args) 1)
(if (c-real? (c-car args))
(if (c-< (c-car args) 0)
(c-* -1 (c-car args))
(c-car args))
(error '|(abs) wrong type of argument --| args))
(error '|(abs) wrong number of arguments --| args)))
(define (append . list-of-list)
(if (c-null? list-of-list)
'()
(begin
(define reversed (c-reverse list-of-list))
(define o (c-car reversed))
(if (or (c-null? o) (c-pair? o))
(begin
(define (iter-1 list result)
(if (c-null? list)
result
(iter-1 (c-cdr list)
(c-cons (c-car list) result))))
(define (iter-2 list-of-list result)
(if (c-null? list-of-list)
result
(if (c-list? (c-car list-of-list))
(iter-2 (c-cdr list-of-list)
(iter-1 (c-reverse (c-car list-of-list))
result))
(error '|(append) wrong type of argument --| args))))
(iter-2 (c-cdr reversed) o))
o))))
(define (binary-port? . args)
(if (c-= (c-length args) 1)
(c-binary-port? (c-car args))
(error '|(binary-port?) wrong number of arguments --| args)))
(define (boolean=? . args)
(if (c-< 1 (c-length args))
(begin
(define boolean (c-car args))
(if (c-boolean? boolean)
(begin
(define (iter booleans)
(if (c-null? booleans)
#t
(if (c-boolean? (c-car booleans))
(if (c-eq? (c-car booleans) boolean)
(iter (c-cdr booleans))
#f)
(error '|(boolean=?) wrong type of argument --|
args))))
(iter (c-cdr args)))
(error '|(boolean=?) wrong type of argument --| args)))
(error '|(boolean=?) wrong number of arguments --| args)))
(define (boolean? . args)
(if (c-= (c-length args) 1)
(c-boolean? (c-car args))
(error '|(boolean?) wrong number of arguments --| args)))
(define (bytevector . args)
(define (byte? o) (and (c-integer? o) (c-exact? o) (c-< -1 o) (c-< o 256)))
(define (bytes? bytes)
(if (c-null? bytes)
#t
(if (byte? (c-car bytes))
(bytes? (c-cdr bytes))
#f)))
(if (bytes? args)
(c-apply c-bytevector args)
(error '|(bytevector) wrong type of argument --| args)))
(define (bytevector-append . args)
(define (bytevectors? bytevectors)
(if (c-null? bytevectors)
#t
(if (c-bytevector? (c-car bytevectors))
(bytevectors? (c-cdr bytevectors))
#f)))
(if (bytevectors? args)
(c-apply c-bytevector-append args)
(error '|(bytevector-append) wrong type of argument --| args)))
(define (bytevector-copy . args)
(define len (c-length args))
(if (and (c-< 0 len) (c-< len 4))
(begin
(define bytevector (c-car args))
(if (c-bytevector? bytevector)
(begin
(define bytevector-len (c-bytevector-length bytevector))
(define start (if (c-= len 1)
0
(c-cadr args)))
(define end (if (c-< len 3)
bytevector-len
(c-caddr args)))
(if (and (c-integer? start) (c-exact? start)
(c-integer? end) (c-exact? end)
(c-< -1 start) (c-< end (c-+ bytevector-len 1))
(c-< start end))
(c-bytevector-copy bytevector start end)
(error '|(bytevector-copy) wrong type of argument --| args)))
(error '|(bytevector-copy) wrong type of argument --| args)))
(error '|(bytevector-copy) wrong number of arguments --| args)))
(define (bytevector-length . args)
(if (c-= (c-length args) 1)
(if (c-bytevector? (c-car args))
(c-bytevector-length (c-car args))
(error '|(bytevector-length) wrong type of argument --| args))
(error '|(bytevector-length) wrong number of arguments --| args)))
(define (bytevector-u8-ref . args)
(if (c-= (c-length args) 2)
(begin
(define bv (c-car args))
(define k (c-cadr args))
(if (and (c-bytevector? bv)
(c-integer? k)
(c-exact? k)
(c-< -1 k)
(c-< k (c-bytevector-length bv)))
(c-bytevector-u8-ref bv k)
(error '|(bytevector-u8-ref) wrong type of argument --| args)))
(error '|(bytevector-u8-ref) wrong number of arguments --| args)))
(define (bytevector-u8-set! . args)
(if (c-= (c-length args) 3)
(begin
(define bv (c-car args))
(define k (c-cadr args))
(define byte (c-caddr args))
(if (and (c-bytevector? bv)
(c-integer? k)
(c-exact? k)
(c-< -1 k)
(c-< k (c-bytevector-length bv)))
(c-bytevector-u8-set! bv k byte)
(error '|(bytevector-u8-set!) wrong type of argument --| args)))
(error '|(bytevector-u8-set!) wrong number of arguments --| args)))
(define (bytevector? . args)
(if (c-= (c-length args) 1)
(c-bytevector? (c-car args))
(error '|(bytevector?) wrong number of arguments --| args)))
(define (car . args)
(if (= (c-length args) 1)
(if (c-pair? (c-car args))
(c-car (c-car args))
(error '|(car) wrong type of argument --| args))
(error '|(car) wrong number of arguments --| args)))
(define (cdr . args)
(if (= (c-length args) 1)
(if (c-pair? (car args))
(c-cdr (c-car args))
(error '|(cdr) wrong type of argument --| args))
(error '|(cdr) wrong number of arguments --| args)))
(define (ceiling . args)
(if (c-= (c-length args) 1)
(if (c-real? (c-car args))
(c-ceiling (c-car args))
(error '|(ceiling) wrong type of argument --| args))
(error '|(ceiling) wrong number of arguments --| args)))
(define (char->integer . args)
(if (c-= (c-length args) 1)
(if (c-char? (c-car args))
(c-char->integer (c-car args))
(error '|(char->integer) wrong type of argument --| args))
(error '|(char->integer) wrong number of arguments --| args)))
(define (cons . args)
(if (c-= (c-length args) 2)
(c-cons (c-car args) (c-cadr args))
(error "(cons) wrong number of arguments --" args)))
(define (length . args)
(if (c-= (c-length args) 1)
(if (c-list? (c-car args))
(c-length (c-car args))
(error '|(length) wrong type of argument --| args))
(error "(length) wrong number of arguments --" args)))
(define (list . args) args)
(define (list? . args)
(if (c-= (c-list? args) 1)
(if (c-list? (c-car args))
(c-list? (c-car args))
(error '|(list?) wrong type of argument --| args))
(error "(list?) wrong number of arguments --" args)))
)
compound_procedures.scm
(begin
(define (assoc obj alist . args)
(define cmp (if (null? args)
(car args)
equal?))
(define (iter alist)
(if (null? alist)
#f
(if (cmp (car (car alist)) obj)
(car alist)
(iter (cdr alist)))))
(iter alist))
(define (assq obj alist) (assoc obj alist eq?))
(define (assv obj alist) (assoc obj alist eqv?))
(define (bytevector-copy! to at from . args)
(define len (length args))
(define start (if (= len 0) 0 (car args)))
(define end (if (= len 2) (cadr args) (bytevector-length from)))
(define (iter i j)
(if (< j end)
(begin
(bytevector-u8-set! to i (bytevector-u8-ref from j))
(iter (+ i 1) (+ j 1)))))
(iter at start))
(define (caar pair) (car (car pair)))
(define (cadr pair) (car (cdr pair)))
(define (cdar pair) (cdr (car pair)))
(define (cddr pair) (cdr (cdr pair)))
)
1 コメント :
شركة تنظيف خزانات بالرياض send.digital/theme1 ان عملية تنظيف الخزانات بالرياض تحتاج الى مهندسين متخصصين فى مجال التنظيف الخاص بالمياه حيث أن المياه تعتبر من الأمور الهامة التى تتعلق بالأسرة كلها حيث أنها مورد يصل الى كل فرد من أفراد الأسرة لذلك عميلنا العزيز عليك بالأهتمام بها .
حيث يصلك مجموعة من المهندسين المختصين بعملية تنظيف الخزانات ويتم تفريغ الخزان نهائياً والقيام بعملية التنظيف باستخدام مجموعة مواد التنظيف التى تعمل على قتل الجراثيم والبكتريا بنسبة 100% ثم يتم ملىء الخزان مرة أخرى والقيام بعملية الاختبار لبيان مدى نظافة ونقاء المياه.… اقرأ المزيد
المصدر: شركة تنظيف خزانات بالرياض
افضل شركة تخزين اثاث بالرياض sites.social/theme6 لكى تتم عمليه التخزين بالشكل المرغوب فيه لابد من اتباع مجموعه من الطرق والخطوات من أبرزها :
1-الاعتماد على مجموعه من المستودعات الكبيرة التى تكفى لعدد هائل من العملاء ؛فالمستودعات مكان شاسع لديه عدد كبير من الحجرات والأدوار التى تكفى للكثير من أجزاء العفش أو الاثاث بمختلف أشكاله ؛سواء الاثاث المنزلى أو الفندقى أو غيرها من أشكال الاثاث الأخرى .
2-العمل على تركيب مجموعه من أجهزة الانذار أو التنبيه التى تنذر بوجود أى مشكلات داخل المستودعات .
3-العمل على تركيب مجموعه من البوابات المحكمة التى تساعد على حمايه المخازن من التعرض للسرقات أو الحرائق.
4-العنايه بأعمال تنظيف المخازن والمستودعات من التعرض للشوائب والأدخنة والتلفيات الخطيرة .
5-القيام بأعمال رش الحشرات اعتمادا على مجموعه من المبيدات وأدوات الرش الحديثة للتخلص من كافه أشكال الحشرات من نمل وبق وصراصير وعته وغيرها من أشكال الحشرات الخطيرة الأخرى التى تتسبب فى تأكل وتلف الاثاث وأشكال المجالس بمختلف أشكالها.
5-أعمال تنظيف العفش
تتمكن شركة تنظيف شقق بالرياض من القيام بأعمال تنظيف العفش بجميع أشكاله والحصول على أفضل النتائج المميزة ؛فالشركة تعتمد على أفضل المنظفات الحديثة وأفضل المساحيق القوية وأجهزة البخار التى تساعد على اتمام أعمال تنظيف الاثاث والتخلص من البقع الداكنة التى تحتاج الى أعمال تفتيت سريعه .
1-أعمال تنظيف المجالس
تتمكن الشركة من القيام بأعمال تنظيف الانتريهات أو الكنب وغيرها من أشكال المجالس الأخرى ؛تلك المجالس تتعرض للشوائب والعوالق والأحبار ؛لذلك يتم الاعتماد على مجموعه من الأجهزة وخاصه أجهزة البخار التى تتمكن من تفتيت الدهون والرواسب بمختلف أشكالها .
2-أعمال تنظيف الكنب
تعتبر الكنب من أهم أشكال المجالس التى يتم الاعتماد عليها من أجل الراحة والحصول على قدر مميز من الراحة ؛لذلك فهى تحتاج الى أعمال تنظيف متكررة ويتم الاعتماد على المساحيق والمنظفات الحديثة وأفضل المعطرات التى تساعد على تنظيف الكنب من أى شوائب .
فقط نحن أفضل شركة تخزين عفش بالرياض أفضل شركة سعودية تتمكن من نقل العفش بأفضل الطرق الصحيحة والمميزة ؛فقط نحن الأفضل لا تدع الفرصه تفوتك ؛فنحن شركة لديها مكانة مميزة من بين الشركات الاخرى ؛فقط اتصل بأرقامنا .… اقرأ المزيد
المصدر: شركة تخزين اثاث بالرياض
コメントを投稿