Remove curiosity files from tree
This commit is contained in:
parent
349a42510f
commit
53e6421ce1
|
@ -1,47 +0,0 @@
|
||||||
iIYVVVVXVVVVVVVVVYVYVYYVYYYYIIIIYYYIYVVVYYYYYYYYYVVYVVVVXVVVVVYI+.
|
|
||||||
tYVXXXXXXVXXXXVVVYVVVVVVVVVVVVYVVVVVVVVVVVVVVVVVXXXXXVXXXXXXXVVYi.
|
|
||||||
iYXRXRRRXXXXXXXXXXXVVXVXVVVVVVVVXXXVXVVXXXXXXXXXXXXXXRRRRRRRRRXVi.
|
|
||||||
tVRRRRRRRRRRRRRRRXRXXXXXXXXXXXXXXRRXXXXRRRRXXXXXXXRRRRRRRRRRRRXV+.
|
|
||||||
tVRRBBBRMBRRRRRRRRRXXRRRRRXt=+;;;;;==iVXRRRRXXXXRRRRRRRRMMBRRRRXi,
|
|
||||||
tVRRBMBBMMBBBBBMBBRBBBRBX++=++;;;;;;:;;;IRRRRXXRRRBBBBBBMMBBBRRXi,
|
|
||||||
iVRMMMMMMMMMMMMMMBRBBMMV==iIVYIi=;;;;:::;;XRRRRRRBBMMMMMMMMBBRRXi.
|
|
||||||
iVRMMMMMMMMMMMMMMMMMMMY;IBWWWWMMXYi=;:::::;RBBBMMMMMMMMMMMMMMBBXi,
|
|
||||||
+VRMMRBMMMMMMMMMMMMMMY+;VMMMMMMMRXIi=;:::::=VVXXXRRRMMMMMMMMBBMXi;
|
|
||||||
=tYYVVVXRRRXXRBMMMMMV+;=RBBMMMXVXXVYt;::::::ttYYVYVVRMMMMMMBXXVI+=
|
|
||||||
;=tIYYVYYYYYYVVVMMMBt=;;+i=IBi+t==;;i;::::::+iitIIttYRMMMMMRXVVI=;
|
|
||||||
;=IIIIYYYIIIIttIYItIt;;=VVYXBIVRXVVXI;::::::;+iitttttVMMBRRRVVVI+,
|
|
||||||
;+++tttIttttiiii+i++==;;RMMMBXXMMMXI+;::::::;+ittttitYVXVYYIYVIi;;
|
|
||||||
;===iiittiiIitiii++;;;;:IVRVi=iBXVIi;::::::::;==+++++iiittii+++=;;
|
|
||||||
;;==+iiiiiiiiii+++=;;;;;;VYVIiiiVVt+;::::::::;++++++++++iti++++=;;
|
|
||||||
;;=++iiii+i+++++iii==;;;::tXYIIYIi+=;:::::,::;+++++++++++++++++=;;
|
|
||||||
;;;+==+ii+++++iiiiit=;;:::::=====;;;::::::::::+++i+++++++++i+++;;;
|
|
||||||
;;;==+=+iiiiitttIIII+;;;:,::,;;;;:;=;;;::,::::=++++++++==++++++;;;
|
|
||||||
:;====+tittiiittttti+;;::::,:=Ytiiiiti=;:::::,:;;==ii+ittItii+==;;
|
|
||||||
;;+iiittIti+ii;;===;;:;::::;+IVXVVVVVVt;;;;;::::;;===;+IIiiti=;;;;
|
|
||||||
;=++++iIti+ii+=;;;=;:::;;+VXBMMBBBBBBXY=;=;;:::::;=iYVIIttii++;;;;
|
|
||||||
;;++iiiItttIi+++=;;:::;=iBMMMMMMMMMMMXI==;;,::;;:;;=+itIttIIti+;;;
|
|
||||||
;=+++++i+tYIIiii;:,::;itXMMMMMMMMMMMBXti==;:;++=;:::::;=+iittti+;;
|
|
||||||
;;+ii+ii+iitiIi;::::;iXBMMMMMWWWWWMMBXti+ii=;::::,,,,:::=;==+tI+;;
|
|
||||||
;;iiiitItttti;:::;::=+itYXXMWWWWWWMBYt+;;::,,,,,,,,,,,,,:==;==;;;;
|
|
||||||
:;=iIIIttIt+:;:::;;;==;+=+iiittttti+;;:,:,,,,::,,,,,,,,:::;=;==::;
|
|
||||||
;::=+ittiii=;:::::;;;:;:;=++==;;==;:,,,,,,:;::::,,,,,,,,::;==;;::;
|
|
||||||
:::;+iiiii=;::::,:;:::::;;:;;::;:::,,,,,,,:::;=;;;:,,,,,:::;;::::;
|
|
||||||
:;;iIIIIII=;:::,:::::::,::::,:::,,,,,,,,,,,:;;=;:,,,,,,::::;=;:::;
|
|
||||||
:;==++ii+;;;:::::::::::,,,,,,::,,,,,,,,,,,::::,,,,,,,,,,:,:::::::;
|
|
||||||
::;;=+=;;;:::;;::,,,,,,,,,,,,,,,,,,,,,,,,,:,,,,,,,,,,,,,,,,,:::::;
|
|
||||||
::;=;;;:;:::;;;;::,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,::,,::::;
|
|
||||||
:;;:;::::::,::,,:,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:::;
|
|
||||||
:::::::::::;;;:,,,,,,,,,,,,,...,...,,,.,,,,,,,,,,,,.,,,,,,,,,,,,:;
|
|
||||||
::::::::;=;;;;;::,,,,,,,,,,,.......,...,,,,,,,,,,,,.,,,,,,,,,,,,,;
|
|
||||||
:::::,,:;=;;;;;;;iVXXXVt+:,,....,,,,....,.,,,,,,,.,.....,,,,,,,,:;
|
|
||||||
:,,::,,:::;;;;;;=IVVVXXXXVXVt:,,,,,..,..,,,,.,,,,,..,.,,,,,,,,,,,;
|
|
||||||
::,::,,,:,:::::,::;=iIYVXVVVVIYIi;,,.,.,,,::,,,,,,,,,,,,,,,,,,,,,.
|
|
||||||
:,,,,,,,,,,,,,,,,::;+itIIIIIIi:;;i++=;;;;;;;;;::,,,...,,..,,,,,,,.
|
|
||||||
:,,,,,,,,,,,,,,=iitVYi++iitt==it;;:;;;;::;;::::,,,......,,,,,,,::.
|
|
||||||
::,,,,,,,,,,,,,++iiIVIi=;;=;+i;:;+:::,,,,,,,,,,,,,.....,,,,,,,,::,
|
|
||||||
,,,,,,,,,,,,,,,;=+it=:::,,,,,,,,,,.,......,,.,..........,,,,,,,,::
|
|
||||||
:,,,,,,,,,,,,,,,,:=:,,,,,,,,,,,,,,......................,.,,.,.,,:
|
|
||||||
:,,,,,,,,,,,,,,,,,:,,,,,,,,,,..,........................,..,...,,:
|
|
||||||
,,,,,,,,,,,,,,,,,,,.....................................,.......,,
|
|
||||||
,,,,,,,,,.,,,,,,,...............................................,,
|
|
||||||
itittiiiii+=++=;;=iiiiiiittiiiiii+iii===;++iiitiiiiiii+=====+ii=+i
|
|
|
@ -1,71 +0,0 @@
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>''''''<!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!'''''` ``'!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!''` ..... `'!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!'` . :::::' `'!!!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!!!!' . ' .::::' `!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!!' : ````` `!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!! .,cchcccccc,,. `!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!! .-"?$$$$$$$$$$$$$$c, `!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!! ,ccc$$$$$$$$$$$$$$$$$$$, `!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!! z$$$$$$$$$$$$$$$$$$$$$$$$;. `!!!!!!!!!
|
|
||||||
!!!!!!!!!!!! <$$$$$$$$$$$$$$$$$$$$$$$$$$:. `!!!!!!!!
|
|
||||||
!!!!!!!!!!! $$$$$$$$$$$$$$$$$$$$$$$$$$$h;:. !!!!!!!!
|
|
||||||
!!!!!!!!!!' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$h;. !!!!!!!
|
|
||||||
!!!!!!!!!' <$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ !!!!!!!
|
|
||||||
!!!!!!!!' `$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F `!!!!!!
|
|
||||||
!!!!!!!! c$$$$???$$$$$$$P"" """??????" !!!!!!
|
|
||||||
!!!!!!! `"" .,.. "$$$$F .,zcr !!!!!!
|
|
||||||
!!!!!!! . dL .?$$$ .,cc, .,z$h. !!!!!!
|
|
||||||
!!!!!!!! <. $$c= <$d$$$ <$$$$=-=+"$$$$$$$ !!!!!!
|
|
||||||
!!!!!!! d$$$hcccd$$$$$ d$$$hcccd$$$$$$$F `!!!!!
|
|
||||||
!!!!!! ,$$$$$$$$$$$$$$h d$$$$$$$$$$$$$$$$ `!!!!!
|
|
||||||
!!!!! `$$$$$$$$$$$$$$$<$$$$$$$$$$$$$$$$' !!!!!
|
|
||||||
!!!!! `$$$$$$$$$$$$$$$$"$$$$$$$$$$$$$P> !!!!!
|
|
||||||
!!!!! ?$$$$$$$$$$$$??$c`$$$$$$$$$$$?>' `!!!!
|
|
||||||
!!!!! `?$$$$$$I7?"" ,$$$$$$$$$?>>' !!!!
|
|
||||||
!!!!!. <<?$$$$$$c. ,d$$?$$$$$F>>'' `!!!
|
|
||||||
!!!!!! <i?$P"??$$r--"?"" ,$$$$h;>'' `!!!
|
|
||||||
!!!!!! $$$hccccccccc= cc$$$$$$$>>' !!!
|
|
||||||
!!!!! `?$$$$$$F"""" `"$$$$$>>>'' `!!
|
|
||||||
!!!!! "?$$$$$cccccc$$$$??>>>>' !!
|
|
||||||
!!!!> "$$$$$$$$$$$$$F>>>>'' `!
|
|
||||||
!!!!! "$$$$$$$$???>''' !
|
|
||||||
!!!!!> `""""" `
|
|
||||||
!!!!!!; . `
|
|
||||||
!!!!!!! ?h.
|
|
||||||
!!!!!!!! $$c,
|
|
||||||
!!!!!!!!> ?$$$h. .,c
|
|
||||||
!!!!!!!!! $$$$$$$$$hc,.,,cc$$$$$
|
|
||||||
!!!!!!!!! .,zcc$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
!!!!!!!!! .z$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ .
|
|
||||||
!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ !!
|
|
||||||
!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ,!'
|
|
||||||
!!!!!!!!> c$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$. !'
|
|
||||||
!!!!!!'' ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> '
|
|
||||||
!!!'' z$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$>
|
|
||||||
!' ,$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> ..
|
|
||||||
z$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' ;!!!!''`
|
|
||||||
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F ,;;!'`' .''
|
|
||||||
<$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> ,;'`' ,;
|
|
||||||
`$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F -' ,;!!'
|
|
||||||
"?$$$$$$$$$$?$$$$$$$$$$$$$$$$$$$$$$$$$$F .<!!!''' <!
|
|
||||||
!> ""??$$$?C3$$$$$$$$$$$$$$$$$$$$$$$$"" ;!''' !!!
|
|
||||||
;!!!!;, `"''""????$$$$$$$$$$$$$$$$"" ,;-'' ',!
|
|
||||||
;!!!!<!!!; . `""""""""""" `' ' '
|
|
||||||
!!!! ;!!! ;!!!!>;,;, .. ' . ' '
|
|
||||||
!!' ,;!!! ;'`!!!!!!!!;!!!!!; . >' .'' ;
|
|
||||||
!!' ;!!'!';! !! !!!!!!!!!!!!! ' -'
|
|
||||||
<!! !! `!;! `!' !!!!!!!!!!<! .
|
|
||||||
`! ;! ;!!! <' <!!!! `!!! < /
|
|
||||||
`; !> <!! ;' !!!!' !!';! ;'
|
|
||||||
! ! !!! ! `!!! ;!! ! ' '
|
|
||||||
; `! `!! ,' !' ;!'
|
|
||||||
' /`! ! < !! < '
|
|
||||||
/ ;! >;! ;>
|
|
||||||
!' ; !! '
|
|
||||||
' ;! > ! '
|
|
||||||
'
|
|
||||||
by Allen Mullen
|
|
212
llt/UTF8.txt
212
llt/UTF8.txt
|
@ -1,212 +0,0 @@
|
||||||
|
|
||||||
UTF-8 encoded sample plain-text file
|
|
||||||
‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
|
||||||
|
|
||||||
Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25
|
|
||||||
|
|
||||||
|
|
||||||
The ASCII compatible UTF-8 encoding used in this plain-text file
|
|
||||||
is defined in Unicode, ISO 10646-1, and RFC 2279.
|
|
||||||
|
|
||||||
|
|
||||||
Using Unicode/UTF-8, you can write in emails and source code things such as
|
|
||||||
|
|
||||||
Mathematics and sciences:
|
|
||||||
|
|
||||||
∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫
|
|
||||||
⎪⎢⎜│a²+b³ ⎟⎥⎪
|
|
||||||
∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪
|
|
||||||
⎪⎢⎜⎷ c₈ ⎟⎥⎪
|
|
||||||
ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬
|
|
||||||
⎪⎢⎜ ∞ ⎟⎥⎪
|
|
||||||
⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪
|
|
||||||
⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪
|
|
||||||
2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭
|
|
||||||
|
|
||||||
Linguistics and dictionaries:
|
|
||||||
|
|
||||||
ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn
|
|
||||||
Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]
|
|
||||||
|
|
||||||
APL:
|
|
||||||
|
|
||||||
((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈
|
|
||||||
|
|
||||||
Nicer typography in plain text files:
|
|
||||||
|
|
||||||
╔══════════════════════════════════════════╗
|
|
||||||
║ ║
|
|
||||||
║ • ‘single’ and “double” quotes ║
|
|
||||||
║ ║
|
|
||||||
║ • Curly apostrophes: “We’ve been here” ║
|
|
||||||
║ ║
|
|
||||||
║ • Latin-1 apostrophe and accents: '´` ║
|
|
||||||
║ ║
|
|
||||||
║ • ‚deutsche‘ „Anführungszeichen“ ║
|
|
||||||
║ ║
|
|
||||||
║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║
|
|
||||||
║ ║
|
|
||||||
║ • ASCII safety test: 1lI|, 0OD, 8B ║
|
|
||||||
║ ╭─────────╮ ║
|
|
||||||
║ • the euro symbol: │ 14.95 € │ ║
|
|
||||||
║ ╰─────────╯ ║
|
|
||||||
╚══════════════════════════════════════════╝
|
|
||||||
|
|
||||||
Combining characters:
|
|
||||||
|
|
||||||
STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑
|
|
||||||
|
|
||||||
Greek (in Polytonic):
|
|
||||||
|
|
||||||
The Greek anthem:
|
|
||||||
|
|
||||||
Σὲ γνωρίζω ἀπὸ τὴν κόψη
|
|
||||||
τοῦ σπαθιοῦ τὴν τρομερή,
|
|
||||||
σὲ γνωρίζω ἀπὸ τὴν ὄψη
|
|
||||||
ποὺ μὲ βία μετράει τὴ γῆ.
|
|
||||||
|
|
||||||
᾿Απ᾿ τὰ κόκκαλα βγαλμένη
|
|
||||||
τῶν ῾Ελλήνων τὰ ἱερά
|
|
||||||
καὶ σὰν πρῶτα ἀνδρειωμένη
|
|
||||||
χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!
|
|
||||||
|
|
||||||
From a speech of Demosthenes in the 4th century BC:
|
|
||||||
|
|
||||||
Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,
|
|
||||||
ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς
|
|
||||||
λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ
|
|
||||||
τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿
|
|
||||||
εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ
|
|
||||||
πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν
|
|
||||||
οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,
|
|
||||||
οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν
|
|
||||||
ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον
|
|
||||||
τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι
|
|
||||||
γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν
|
|
||||||
προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους
|
|
||||||
σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ
|
|
||||||
τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ
|
|
||||||
τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς
|
|
||||||
τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.
|
|
||||||
|
|
||||||
Δημοσθένους, Γ´ ᾿Ολυνθιακὸς
|
|
||||||
|
|
||||||
Georgian:
|
|
||||||
|
|
||||||
From a Unicode conference invitation:
|
|
||||||
|
|
||||||
გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო
|
|
||||||
კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,
|
|
||||||
ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს
|
|
||||||
ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,
|
|
||||||
ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება
|
|
||||||
ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,
|
|
||||||
ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.
|
|
||||||
|
|
||||||
Russian:
|
|
||||||
|
|
||||||
From a Unicode conference invitation:
|
|
||||||
|
|
||||||
Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
|
|
||||||
Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
|
|
||||||
Конференция соберет широкий круг экспертов по вопросам глобального
|
|
||||||
Интернета и Unicode, локализации и интернационализации, воплощению и
|
|
||||||
применению Unicode в различных операционных системах и программных
|
|
||||||
приложениях, шрифтах, верстке и многоязычных компьютерных системах.
|
|
||||||
|
|
||||||
Thai (UCS Level 2):
|
|
||||||
|
|
||||||
Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
|
|
||||||
classic 'San Gua'):
|
|
||||||
|
|
||||||
[----------------------------|------------------------]
|
|
||||||
๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่
|
|
||||||
สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา
|
|
||||||
ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา
|
|
||||||
โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ
|
|
||||||
เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ
|
|
||||||
ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ
|
|
||||||
พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้
|
|
||||||
ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ
|
|
||||||
|
|
||||||
(The above is a two-column text. If combining characters are handled
|
|
||||||
correctly, the lines of the second column should be aligned with the
|
|
||||||
| character above.)
|
|
||||||
|
|
||||||
Ethiopian:
|
|
||||||
|
|
||||||
Proverbs in the Amharic language:
|
|
||||||
|
|
||||||
ሰማይ አይታረስ ንጉሥ አይከሰስ።
|
|
||||||
ብላ ካለኝ እንደአባቴ በቆመጠኝ።
|
|
||||||
ጌጥ ያለቤቱ ቁምጥና ነው።
|
|
||||||
ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።
|
|
||||||
የአፍ ወለምታ በቅቤ አይታሽም።
|
|
||||||
አይጥ በበላ ዳዋ ተመታ።
|
|
||||||
ሲተረጉሙ ይደረግሙ።
|
|
||||||
ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።
|
|
||||||
ድር ቢያብር አንበሳ ያስር።
|
|
||||||
ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።
|
|
||||||
እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።
|
|
||||||
የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።
|
|
||||||
ሥራ ከመፍታት ልጄን ላፋታት።
|
|
||||||
ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።
|
|
||||||
የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።
|
|
||||||
ተንጋሎ ቢተፉ ተመልሶ ባፉ።
|
|
||||||
ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።
|
|
||||||
እግርህን በፍራሽህ ልክ ዘርጋ።
|
|
||||||
|
|
||||||
Runes:
|
|
||||||
|
|
||||||
ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ
|
|
||||||
|
|
||||||
(Old English, which transcribed into Latin reads 'He cwaeth that he
|
|
||||||
bude thaem lande northweardum with tha Westsae.' and means 'He said
|
|
||||||
that he lived in the northern land near the Western Sea.')
|
|
||||||
|
|
||||||
Braille:
|
|
||||||
|
|
||||||
⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌
|
|
||||||
|
|
||||||
⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞
|
|
||||||
⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎
|
|
||||||
⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂
|
|
||||||
⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙
|
|
||||||
⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑
|
|
||||||
⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲
|
|
||||||
|
|
||||||
⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
|
|
||||||
|
|
||||||
⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹
|
|
||||||
⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞
|
|
||||||
⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕
|
|
||||||
⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹
|
|
||||||
⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎
|
|
||||||
⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎
|
|
||||||
⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳
|
|
||||||
⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞
|
|
||||||
⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
|
|
||||||
|
|
||||||
(The first couple of paragraphs of "A Christmas Carol" by Dickens)
|
|
||||||
|
|
||||||
Compact font selection example text:
|
|
||||||
|
|
||||||
ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
|
|
||||||
abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ
|
|
||||||
–—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд
|
|
||||||
∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi<>⑀₂ἠḂӥẄɐː⍎אԱა
|
|
||||||
|
|
||||||
Greetings in various languages:
|
|
||||||
|
|
||||||
Hello world, Καλημέρα κόσμε, コンニチハ
|
|
||||||
|
|
||||||
Box drawing alignment tests: █
|
|
||||||
▉
|
|
||||||
╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳
|
|
||||||
║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳
|
|
||||||
║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳
|
|
||||||
╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳
|
|
||||||
║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎
|
|
||||||
║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏
|
|
||||||
╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█
|
|
||||||
▝▀▘▙▄▟
|
|
|
@ -1,23 +0,0 @@
|
||||||
FREEBSD-GE-10 = $(shell test `uname` = FreeBSD -a `uname -r | cut -d. -f1` -ge 10 && echo YES)
|
|
||||||
CC = $(if $(FREEBSD-GE-10),clang,gcc)
|
|
||||||
|
|
||||||
NAME = lisp
|
|
||||||
SRC = $(NAME).c
|
|
||||||
EXENAME = $(NAME)
|
|
||||||
|
|
||||||
FLAGS = -Wall -Wextra
|
|
||||||
LIBS =
|
|
||||||
|
|
||||||
DEBUGFLAGS = -g -DDEBUG $(FLAGS)
|
|
||||||
SHIPFLAGS = -O3 -fomit-frame-pointer $(FLAGS)
|
|
||||||
|
|
||||||
default: release
|
|
||||||
|
|
||||||
debug: $(SRC)
|
|
||||||
$(CC) $(DEBUGFLAGS) $(SRC) -o $(EXENAME) $(LIBS)
|
|
||||||
|
|
||||||
release: $(SRC)
|
|
||||||
$(CC) $(SHIPFLAGS) $(SRC) -o $(EXENAME) $(LIBS)
|
|
||||||
|
|
||||||
clean:
|
|
||||||
rm -f $(EXENAME)
|
|
390
tiny/eval1
390
tiny/eval1
|
@ -1,390 +0,0 @@
|
||||||
value_t eval_sexpr(value_t e, value_t *penv)
|
|
||||||
{
|
|
||||||
value_t f, v, bind, headsym, asym, labl=0, *pv, *argsyms, *body, *lenv;
|
|
||||||
value_t *rest;
|
|
||||||
cons_t *c;
|
|
||||||
symbol_t *sym;
|
|
||||||
u_int32_t saveSP;
|
|
||||||
int i, nargs, noeval=0;
|
|
||||||
number_t s, n;
|
|
||||||
|
|
||||||
if (issymbol(e)) {
|
|
||||||
sym = (symbol_t*)ptr(e);
|
|
||||||
if (sym->constant != UNBOUND) return sym->constant;
|
|
||||||
v = *penv;
|
|
||||||
while (iscons(v)) {
|
|
||||||
bind = car_(v);
|
|
||||||
if (iscons(bind) && car_(bind) == e)
|
|
||||||
return cdr_(bind);
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
if ((v = sym->binding) == UNBOUND)
|
|
||||||
lerror("eval: error: variable %s has no value\n", sym->name);
|
|
||||||
return v;
|
|
||||||
}
|
|
||||||
if ((unsigned)(char*)&nargs < (unsigned)stack_bottom || SP>=(N_STACK-100))
|
|
||||||
lerror("eval: error: stack overflow\n");
|
|
||||||
saveSP = SP;
|
|
||||||
PUSH(e);
|
|
||||||
f = eval(car_(e), penv);
|
|
||||||
if (isbuiltin(f)) {
|
|
||||||
// handle builtin function
|
|
||||||
if (!isspecial(f)) {
|
|
||||||
// evaluate argument list, placing arguments on stack
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
while (iscons(v)) {
|
|
||||||
v = eval(car_(v), penv);
|
|
||||||
PUSH(v);
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
apply_builtin:
|
|
||||||
nargs = SP - saveSP - 1;
|
|
||||||
switch (intval(f)) {
|
|
||||||
// special forms
|
|
||||||
case F_QUOTE:
|
|
||||||
v = cdr_(Stack[saveSP]);
|
|
||||||
if (!iscons(v))
|
|
||||||
lerror("quote: error: expected argument\n");
|
|
||||||
v = car_(v);
|
|
||||||
break;
|
|
||||||
case F_MACRO:
|
|
||||||
case F_LAMBDA:
|
|
||||||
v = Stack[saveSP];
|
|
||||||
if (*penv != NIL) {
|
|
||||||
// build a closure (lambda args body . env)
|
|
||||||
v = cdr_(v);
|
|
||||||
PUSH(car(v));
|
|
||||||
argsyms = &Stack[SP-1];
|
|
||||||
PUSH(car(cdr_(v)));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
v = cons_(intval(f)==F_LAMBDA ? &LAMBDA : &MACRO,
|
|
||||||
cons(argsyms, cons(body, penv)));
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_LABEL:
|
|
||||||
v = Stack[saveSP];
|
|
||||||
if (*penv != NIL) {
|
|
||||||
v = cdr_(v);
|
|
||||||
PUSH(car(v)); // name
|
|
||||||
pv = &Stack[SP-1];
|
|
||||||
PUSH(car(cdr_(v))); // function
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
*body = eval(*body, penv); // evaluate lambda
|
|
||||||
v = cons_(&LABEL, cons(pv, cons(body, &NIL)));
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_IF:
|
|
||||||
v = car(cdr_(Stack[saveSP]));
|
|
||||||
if (eval(v, penv) != NIL)
|
|
||||||
v = car(cdr_(cdr_(Stack[saveSP])));
|
|
||||||
else
|
|
||||||
v = car(cdr(cdr_(cdr_(Stack[saveSP]))));
|
|
||||||
v = eval(v, penv);
|
|
||||||
break;
|
|
||||||
case F_COND:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
c = tocons(car_(*pv), "cond");
|
|
||||||
if ((v=eval(c->car, penv)) != NIL) {
|
|
||||||
*pv = cdr_(car_(*pv));
|
|
||||||
// evaluate body forms
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
v = eval(car_(*pv), penv);
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_AND:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = T;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
if ((v=eval(car_(*pv), penv)) == NIL)
|
|
||||||
break;
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_OR:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
if ((v=eval(car_(*pv), penv)) != NIL)
|
|
||||||
break;
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_WHILE:
|
|
||||||
PUSH(car(cdr(cdr_(Stack[saveSP]))));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
Stack[saveSP] = car_(cdr_(Stack[saveSP]));
|
|
||||||
value_t *cond = &Stack[saveSP];
|
|
||||||
PUSH(NIL); pv = &Stack[SP-1];
|
|
||||||
while (eval(*cond, penv) != NIL)
|
|
||||||
*pv = eval(*body, penv);
|
|
||||||
v = *pv;
|
|
||||||
break;
|
|
||||||
case F_PROGN:
|
|
||||||
// return last arg
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
v = eval(car_(*pv), penv);
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
|
|
||||||
// ordinary functions
|
|
||||||
case F_SET:
|
|
||||||
argcount("set", nargs, 2);
|
|
||||||
e = Stack[SP-2];
|
|
||||||
v = *penv;
|
|
||||||
while (iscons(v)) {
|
|
||||||
bind = car_(v);
|
|
||||||
if (iscons(bind) && car_(bind) == e) {
|
|
||||||
cdr_(bind) = (v=Stack[SP-1]);
|
|
||||||
SP=saveSP; return v;
|
|
||||||
}
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
tosymbol(e, "set")->binding = (v=Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_BOUNDP:
|
|
||||||
argcount("boundp", nargs, 1);
|
|
||||||
if (tosymbol(Stack[SP-1], "boundp")->binding == UNBOUND)
|
|
||||||
v = NIL;
|
|
||||||
else
|
|
||||||
v = T;
|
|
||||||
break;
|
|
||||||
case F_EQ:
|
|
||||||
argcount("eq", nargs, 2);
|
|
||||||
v = ((Stack[SP-2] == Stack[SP-1]) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_CONS:
|
|
||||||
argcount("cons", nargs, 2);
|
|
||||||
v = mk_cons();
|
|
||||||
car_(v) = Stack[SP-2];
|
|
||||||
cdr_(v) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_CAR:
|
|
||||||
argcount("car", nargs, 1);
|
|
||||||
v = car(Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_CDR:
|
|
||||||
argcount("cdr", nargs, 1);
|
|
||||||
v = cdr(Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_RPLACA:
|
|
||||||
argcount("rplaca", nargs, 2);
|
|
||||||
car(v=Stack[SP-2]) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_RPLACD:
|
|
||||||
argcount("rplacd", nargs, 2);
|
|
||||||
cdr(v=Stack[SP-2]) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_ATOM:
|
|
||||||
argcount("atom", nargs, 1);
|
|
||||||
v = ((!iscons(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_SYMBOLP:
|
|
||||||
argcount("symbolp", nargs, 1);
|
|
||||||
v = ((issymbol(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_NUMBERP:
|
|
||||||
argcount("numberp", nargs, 1);
|
|
||||||
v = ((isnumber(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_ADD:
|
|
||||||
s = 0;
|
|
||||||
for (i=saveSP+1; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "+");
|
|
||||||
s += n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_SUB:
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("-: error: too few arguments\n");
|
|
||||||
i = saveSP+1;
|
|
||||||
s = (nargs==1) ? 0 : tonumber(Stack[i++], "-");
|
|
||||||
for (; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "-");
|
|
||||||
s -= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_MUL:
|
|
||||||
s = 1;
|
|
||||||
for (i=saveSP+1; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "*");
|
|
||||||
s *= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_DIV:
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("/: error: too few arguments\n");
|
|
||||||
i = saveSP+1;
|
|
||||||
s = (nargs==1) ? 1 : tonumber(Stack[i++], "/");
|
|
||||||
for (; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "/");
|
|
||||||
if (n == 0)
|
|
||||||
lerror("/: error: division by zero\n");
|
|
||||||
s /= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_LT:
|
|
||||||
argcount("<", nargs, 2);
|
|
||||||
if (tonumber(Stack[SP-2],"<") < tonumber(Stack[SP-1],"<"))
|
|
||||||
v = T;
|
|
||||||
else
|
|
||||||
v = NIL;
|
|
||||||
break;
|
|
||||||
case F_NOT:
|
|
||||||
argcount("not", nargs, 1);
|
|
||||||
v = ((Stack[SP-1] == NIL) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_EVAL:
|
|
||||||
argcount("eval", nargs, 1);
|
|
||||||
v = eval(Stack[SP-1], &NIL);
|
|
||||||
break;
|
|
||||||
case F_PRINT:
|
|
||||||
for (i=saveSP+1; i < (int)SP; i++)
|
|
||||||
print(stdout, v=Stack[i]);
|
|
||||||
break;
|
|
||||||
case F_READ:
|
|
||||||
argcount("read", nargs, 0);
|
|
||||||
v = read_sexpr(stdin);
|
|
||||||
break;
|
|
||||||
case F_LOAD:
|
|
||||||
argcount("load", nargs, 1);
|
|
||||||
v = load_file(tosymbol(Stack[SP-1], "load")->name);
|
|
||||||
break;
|
|
||||||
case F_PROG1:
|
|
||||||
// return first arg
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("prog1: error: too few arguments\n");
|
|
||||||
v = Stack[saveSP+1];
|
|
||||||
break;
|
|
||||||
case F_APPLY:
|
|
||||||
// unpack a list onto the stack
|
|
||||||
argcount("apply", nargs, 2);
|
|
||||||
v = Stack[saveSP] = Stack[SP-1]; // second arg is new arglist
|
|
||||||
f = Stack[SP-2]; // first arg is new function
|
|
||||||
POPN(2); // pop apply's args
|
|
||||||
if (isbuiltin(f)) {
|
|
||||||
if (isspecial(f))
|
|
||||||
lerror("apply: error: cannot apply special operator "
|
|
||||||
"%s\n", builtin_names[intval(f)]);
|
|
||||||
while (iscons(v)) {
|
|
||||||
PUSH(car_(v));
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
goto apply_builtin;
|
|
||||||
}
|
|
||||||
noeval = 1;
|
|
||||||
goto apply_lambda;
|
|
||||||
}
|
|
||||||
SP = saveSP;
|
|
||||||
return v;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
apply_lambda:
|
|
||||||
if (iscons(f)) {
|
|
||||||
headsym = car_(f);
|
|
||||||
if (headsym == LABEL) {
|
|
||||||
// (label name (lambda ...)) behaves the same as the lambda
|
|
||||||
// alone, except with name bound to the whole label expression
|
|
||||||
labl = f;
|
|
||||||
f = car(cdr(cdr_(labl)));
|
|
||||||
headsym = car(f);
|
|
||||||
}
|
|
||||||
// apply lambda or macro expression
|
|
||||||
PUSH(cdr(cdr(cdr_(f))));
|
|
||||||
lenv = &Stack[SP-1];
|
|
||||||
PUSH(car_(cdr_(f)));
|
|
||||||
argsyms = &Stack[SP-1];
|
|
||||||
PUSH(car_(cdr_(cdr_(f))));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
if (labl) {
|
|
||||||
// add label binding to environment
|
|
||||||
PUSH(labl);
|
|
||||||
PUSH(car_(cdr_(labl)));
|
|
||||||
*lenv = cons_(cons(&Stack[SP-1], &Stack[SP-2]), lenv);
|
|
||||||
POPN(3);
|
|
||||||
v = Stack[saveSP]; // refetch arglist
|
|
||||||
}
|
|
||||||
if (headsym == MACRO)
|
|
||||||
noeval = 1;
|
|
||||||
else if (headsym != LAMBDA)
|
|
||||||
lerror("apply: error: head must be lambda, macro, or label\n");
|
|
||||||
// build a calling environment for the lambda
|
|
||||||
// the environment is the argument binds on top of the captured
|
|
||||||
// environment
|
|
||||||
while (iscons(v)) {
|
|
||||||
// bind args
|
|
||||||
if (!iscons(*argsyms)) {
|
|
||||||
if (*argsyms == NIL)
|
|
||||||
lerror("apply: error: too many arguments\n");
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
asym = car_(*argsyms);
|
|
||||||
if (!issymbol(asym))
|
|
||||||
lerror("apply: error: formal argument not a symbol\n");
|
|
||||||
v = car_(v);
|
|
||||||
if (!noeval) v = eval(v, penv);
|
|
||||||
PUSH(v);
|
|
||||||
*lenv = cons_(cons(&asym, &Stack[SP-1]), lenv);
|
|
||||||
POPN(2);
|
|
||||||
*argsyms = cdr_(*argsyms);
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
if (*argsyms != NIL) {
|
|
||||||
if (issymbol(*argsyms)) {
|
|
||||||
if (noeval) {
|
|
||||||
*lenv = cons_(cons(argsyms, &Stack[saveSP]), lenv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
PUSH(NIL);
|
|
||||||
PUSH(NIL);
|
|
||||||
rest = &Stack[SP-1];
|
|
||||||
// build list of rest arguments
|
|
||||||
// we have to build it forwards, which is tricky
|
|
||||||
while (iscons(v)) {
|
|
||||||
v = eval(car_(v), penv);
|
|
||||||
PUSH(v);
|
|
||||||
v = cons_(&Stack[SP-1], &NIL);
|
|
||||||
POP();
|
|
||||||
if (iscons(*rest))
|
|
||||||
cdr_(*rest) = v;
|
|
||||||
else
|
|
||||||
Stack[SP-2] = v;
|
|
||||||
*rest = v;
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
*lenv = cons_(cons(argsyms, &Stack[SP-2]), lenv);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else if (iscons(*argsyms)) {
|
|
||||||
lerror("apply: error: too few arguments\n");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
SP = saveSP; // free temporary stack space
|
|
||||||
PUSH(*lenv); // preserve environment on stack
|
|
||||||
lenv = &Stack[SP-1];
|
|
||||||
v = eval(*body, lenv);
|
|
||||||
POP();
|
|
||||||
// macro: evaluate expansion in the calling environment
|
|
||||||
if (headsym == MACRO)
|
|
||||||
return eval(v, penv);
|
|
||||||
return v;
|
|
||||||
}
|
|
||||||
type_error("apply", "function", f);
|
|
||||||
return NIL;
|
|
||||||
}
|
|
407
tiny/eval2
407
tiny/eval2
|
@ -1,407 +0,0 @@
|
||||||
value_t eval_sexpr(value_t e, value_t *penv)
|
|
||||||
{
|
|
||||||
value_t f, v, bind, headsym, asym, labl=0, *pv, *argsyms, *body, *lenv;
|
|
||||||
value_t *rest;
|
|
||||||
cons_t *c;
|
|
||||||
symbol_t *sym;
|
|
||||||
u_int32_t saveSP;
|
|
||||||
int i, nargs, noeval=0;
|
|
||||||
number_t s, n;
|
|
||||||
|
|
||||||
if (issymbol(e)) {
|
|
||||||
sym = (symbol_t*)ptr(e);
|
|
||||||
if (sym->constant != UNBOUND) return sym->constant;
|
|
||||||
v = *penv;
|
|
||||||
while (iscons(v)) {
|
|
||||||
bind = car_(v);
|
|
||||||
if (iscons(bind) && car_(bind) == e)
|
|
||||||
return cdr_(bind);
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
if ((v = sym->binding) == UNBOUND)
|
|
||||||
lerror("eval: error: variable %s has no value\n", sym->name);
|
|
||||||
return v;
|
|
||||||
}
|
|
||||||
if ((unsigned)(char*)&nargs < (unsigned)stack_bottom || SP>=(N_STACK-100))
|
|
||||||
lerror("eval: error: stack overflow\n");
|
|
||||||
saveSP = SP;
|
|
||||||
PUSH(e);
|
|
||||||
f = eval(car_(e), penv);
|
|
||||||
if (isbuiltin(f)) {
|
|
||||||
// handle builtin function
|
|
||||||
if (!isspecial(f)) {
|
|
||||||
// evaluate argument list, placing arguments on stack
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
while (iscons(v)) {
|
|
||||||
v = eval(car_(v), penv);
|
|
||||||
PUSH(v);
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
apply_builtin:
|
|
||||||
nargs = SP - saveSP - 1;
|
|
||||||
switch (intval(f)) {
|
|
||||||
// special forms
|
|
||||||
case F_QUOTE:
|
|
||||||
v = cdr_(Stack[saveSP]);
|
|
||||||
if (!iscons(v))
|
|
||||||
lerror("quote: error: expected argument\n");
|
|
||||||
v = car_(v);
|
|
||||||
break;
|
|
||||||
case F_MACRO:
|
|
||||||
case F_LAMBDA:
|
|
||||||
v = Stack[saveSP];
|
|
||||||
if (*penv != NIL) {
|
|
||||||
// build a closure (lambda args body . env)
|
|
||||||
v = cdr_(v);
|
|
||||||
PUSH(car(v));
|
|
||||||
argsyms = &Stack[SP-1];
|
|
||||||
PUSH(car(cdr_(v)));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
v = cons_(intval(f)==F_LAMBDA ? &LAMBDA : &MACRO,
|
|
||||||
cons(argsyms, cons(body, penv)));
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_LABEL:
|
|
||||||
v = Stack[saveSP];
|
|
||||||
if (*penv != NIL) {
|
|
||||||
v = cdr_(v);
|
|
||||||
PUSH(car(v)); // name
|
|
||||||
pv = &Stack[SP-1];
|
|
||||||
PUSH(car(cdr_(v))); // function
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
*body = eval(*body, penv); // evaluate lambda
|
|
||||||
v = cons_(&LABEL, cons(pv, cons(body, &NIL)));
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_IF:
|
|
||||||
v = car(cdr_(Stack[saveSP]));
|
|
||||||
if (eval(v, penv) != NIL)
|
|
||||||
v = car(cdr_(cdr_(Stack[saveSP])));
|
|
||||||
else
|
|
||||||
v = car(cdr(cdr_(cdr_(Stack[saveSP]))));
|
|
||||||
v = eval(v, penv);
|
|
||||||
break;
|
|
||||||
case F_COND:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
c = tocons(car_(*pv), "cond");
|
|
||||||
if ((v=eval(c->car, penv)) != NIL) {
|
|
||||||
*pv = cdr_(car_(*pv));
|
|
||||||
// evaluate body forms
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
v = eval(car_(*pv), penv);
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_AND:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = T;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
if ((v=eval(car_(*pv), penv)) == NIL)
|
|
||||||
break;
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_OR:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
if ((v=eval(car_(*pv), penv)) != NIL)
|
|
||||||
break;
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_WHILE:
|
|
||||||
PUSH(car(cdr(cdr_(Stack[saveSP]))));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
Stack[saveSP] = car_(cdr_(Stack[saveSP]));
|
|
||||||
value_t *cond = &Stack[saveSP];
|
|
||||||
PUSH(NIL); pv = &Stack[SP-1];
|
|
||||||
while (eval(*cond, penv) != NIL)
|
|
||||||
*pv = eval(*body, penv);
|
|
||||||
v = *pv;
|
|
||||||
break;
|
|
||||||
case F_PROGN:
|
|
||||||
// return last arg
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
v = eval(car_(*pv), penv);
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
|
|
||||||
// ordinary functions
|
|
||||||
case F_SET:
|
|
||||||
argcount("set", nargs, 2);
|
|
||||||
e = Stack[SP-2];
|
|
||||||
v = *penv;
|
|
||||||
while (iscons(v)) {
|
|
||||||
bind = car_(v);
|
|
||||||
if (iscons(bind) && car_(bind) == e) {
|
|
||||||
cdr_(bind) = (v=Stack[SP-1]);
|
|
||||||
SP=saveSP; return v;
|
|
||||||
}
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
tosymbol(e, "set")->binding = (v=Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_BOUNDP:
|
|
||||||
argcount("boundp", nargs, 1);
|
|
||||||
if (tosymbol(Stack[SP-1], "boundp")->binding == UNBOUND)
|
|
||||||
v = NIL;
|
|
||||||
else
|
|
||||||
v = T;
|
|
||||||
break;
|
|
||||||
case F_EQ:
|
|
||||||
argcount("eq", nargs, 2);
|
|
||||||
v = ((Stack[SP-2] == Stack[SP-1]) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_CONS:
|
|
||||||
argcount("cons", nargs, 2);
|
|
||||||
v = mk_cons();
|
|
||||||
car_(v) = Stack[SP-2];
|
|
||||||
cdr_(v) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_CAR:
|
|
||||||
argcount("car", nargs, 1);
|
|
||||||
v = car(Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_CDR:
|
|
||||||
argcount("cdr", nargs, 1);
|
|
||||||
v = cdr(Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_RPLACA:
|
|
||||||
argcount("rplaca", nargs, 2);
|
|
||||||
car(v=Stack[SP-2]) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_RPLACD:
|
|
||||||
argcount("rplacd", nargs, 2);
|
|
||||||
cdr(v=Stack[SP-2]) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_ATOM:
|
|
||||||
argcount("atom", nargs, 1);
|
|
||||||
v = ((!iscons(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_CONSP:
|
|
||||||
argcount("consp", nargs, 1);
|
|
||||||
v = (iscons(Stack[SP-1]) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_SYMBOLP:
|
|
||||||
argcount("symbolp", nargs, 1);
|
|
||||||
v = ((issymbol(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_NUMBERP:
|
|
||||||
argcount("numberp", nargs, 1);
|
|
||||||
v = ((isnumber(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_ADD:
|
|
||||||
s = 0;
|
|
||||||
for (i=saveSP+1; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "+");
|
|
||||||
s += n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_SUB:
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("-: error: too few arguments\n");
|
|
||||||
i = saveSP+1;
|
|
||||||
s = (nargs==1) ? 0 : tonumber(Stack[i++], "-");
|
|
||||||
for (; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "-");
|
|
||||||
s -= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_MUL:
|
|
||||||
s = 1;
|
|
||||||
for (i=saveSP+1; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "*");
|
|
||||||
s *= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_DIV:
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("/: error: too few arguments\n");
|
|
||||||
i = saveSP+1;
|
|
||||||
s = (nargs==1) ? 1 : tonumber(Stack[i++], "/");
|
|
||||||
for (; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "/");
|
|
||||||
if (n == 0)
|
|
||||||
lerror("/: error: division by zero\n");
|
|
||||||
s /= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_LT:
|
|
||||||
argcount("<", nargs, 2);
|
|
||||||
if (tonumber(Stack[SP-2],"<") < tonumber(Stack[SP-1],"<"))
|
|
||||||
v = T;
|
|
||||||
else
|
|
||||||
v = NIL;
|
|
||||||
break;
|
|
||||||
case F_NOT:
|
|
||||||
argcount("not", nargs, 1);
|
|
||||||
v = ((Stack[SP-1] == NIL) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_EVAL:
|
|
||||||
argcount("eval", nargs, 1);
|
|
||||||
v = eval(Stack[SP-1], &NIL);
|
|
||||||
break;
|
|
||||||
case F_PRINT:
|
|
||||||
for (i=saveSP+1; i < (int)SP; i++)
|
|
||||||
print(stdout, v=Stack[i], 0);
|
|
||||||
fprintf(stdout, "\n");
|
|
||||||
break;
|
|
||||||
case F_PRINC:
|
|
||||||
for (i=saveSP+1; i < (int)SP; i++)
|
|
||||||
print(stdout, v=Stack[i], 1);
|
|
||||||
break;
|
|
||||||
case F_READ:
|
|
||||||
argcount("read", nargs, 0);
|
|
||||||
v = read_sexpr(stdin);
|
|
||||||
break;
|
|
||||||
case F_LOAD:
|
|
||||||
argcount("load", nargs, 1);
|
|
||||||
v = load_file(tosymbol(Stack[SP-1], "load")->name);
|
|
||||||
break;
|
|
||||||
case F_EXIT:
|
|
||||||
exit(0);
|
|
||||||
break;
|
|
||||||
case F_ERROR:
|
|
||||||
for (i=saveSP+1; i < (int)SP; i++)
|
|
||||||
print(stderr, Stack[i], 1);
|
|
||||||
lerror("\n");
|
|
||||||
break;
|
|
||||||
case F_PROG1:
|
|
||||||
// return first arg
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("prog1: error: too few arguments\n");
|
|
||||||
v = Stack[saveSP+1];
|
|
||||||
break;
|
|
||||||
case F_APPLY:
|
|
||||||
// unpack a list onto the stack
|
|
||||||
argcount("apply", nargs, 2);
|
|
||||||
v = Stack[saveSP] = Stack[SP-1]; // second arg is new arglist
|
|
||||||
f = Stack[SP-2]; // first arg is new function
|
|
||||||
POPN(2); // pop apply's args
|
|
||||||
if (isbuiltin(f)) {
|
|
||||||
if (isspecial(f))
|
|
||||||
lerror("apply: error: cannot apply special operator "
|
|
||||||
"%s\n", builtin_names[intval(f)]);
|
|
||||||
while (iscons(v)) {
|
|
||||||
PUSH(car_(v));
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
goto apply_builtin;
|
|
||||||
}
|
|
||||||
noeval = 1;
|
|
||||||
goto apply_lambda;
|
|
||||||
}
|
|
||||||
SP = saveSP;
|
|
||||||
return v;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
apply_lambda:
|
|
||||||
if (iscons(f)) {
|
|
||||||
headsym = car_(f);
|
|
||||||
if (headsym == LABEL) {
|
|
||||||
// (label name (lambda ...)) behaves the same as the lambda
|
|
||||||
// alone, except with name bound to the whole label expression
|
|
||||||
labl = f;
|
|
||||||
f = car(cdr(cdr_(labl)));
|
|
||||||
headsym = car(f);
|
|
||||||
}
|
|
||||||
// apply lambda or macro expression
|
|
||||||
PUSH(cdr(cdr(cdr_(f))));
|
|
||||||
lenv = &Stack[SP-1];
|
|
||||||
PUSH(car_(cdr_(f)));
|
|
||||||
argsyms = &Stack[SP-1];
|
|
||||||
PUSH(car_(cdr_(cdr_(f))));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
if (labl) {
|
|
||||||
// add label binding to environment
|
|
||||||
PUSH(labl);
|
|
||||||
PUSH(car_(cdr_(labl)));
|
|
||||||
*lenv = cons_(cons(&Stack[SP-1], &Stack[SP-2]), lenv);
|
|
||||||
POPN(3);
|
|
||||||
v = Stack[saveSP]; // refetch arglist
|
|
||||||
}
|
|
||||||
if (headsym == MACRO)
|
|
||||||
noeval = 1;
|
|
||||||
else if (headsym != LAMBDA)
|
|
||||||
lerror("apply: error: head must be lambda, macro, or label\n");
|
|
||||||
// build a calling environment for the lambda
|
|
||||||
// the environment is the argument binds on top of the captured
|
|
||||||
// environment
|
|
||||||
while (iscons(v)) {
|
|
||||||
// bind args
|
|
||||||
if (!iscons(*argsyms)) {
|
|
||||||
if (*argsyms == NIL)
|
|
||||||
lerror("apply: error: too many arguments\n");
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
asym = car_(*argsyms);
|
|
||||||
if (!issymbol(asym))
|
|
||||||
lerror("apply: error: formal argument not a symbol\n");
|
|
||||||
v = car_(v);
|
|
||||||
if (!noeval) v = eval(v, penv);
|
|
||||||
PUSH(v);
|
|
||||||
*lenv = cons_(cons(&asym, &Stack[SP-1]), lenv);
|
|
||||||
POPN(2);
|
|
||||||
*argsyms = cdr_(*argsyms);
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
if (*argsyms != NIL) {
|
|
||||||
if (issymbol(*argsyms)) {
|
|
||||||
if (noeval) {
|
|
||||||
*lenv = cons_(cons(argsyms, &Stack[saveSP]), lenv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
PUSH(NIL);
|
|
||||||
PUSH(NIL);
|
|
||||||
rest = &Stack[SP-1];
|
|
||||||
// build list of rest arguments
|
|
||||||
// we have to build it forwards, which is tricky
|
|
||||||
while (iscons(v)) {
|
|
||||||
v = eval(car_(v), penv);
|
|
||||||
PUSH(v);
|
|
||||||
v = cons_(&Stack[SP-1], &NIL);
|
|
||||||
POP();
|
|
||||||
if (iscons(*rest))
|
|
||||||
cdr_(*rest) = v;
|
|
||||||
else
|
|
||||||
Stack[SP-2] = v;
|
|
||||||
*rest = v;
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
*lenv = cons_(cons(argsyms, &Stack[SP-2]), lenv);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else if (iscons(*argsyms)) {
|
|
||||||
lerror("apply: error: too few arguments\n");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
SP = saveSP; // free temporary stack space
|
|
||||||
PUSH(*lenv); // preserve environment on stack
|
|
||||||
lenv = &Stack[SP-1];
|
|
||||||
v = eval(*body, lenv);
|
|
||||||
POP();
|
|
||||||
// macro: evaluate expansion in the calling environment
|
|
||||||
if (headsym == MACRO)
|
|
||||||
return eval(v, penv);
|
|
||||||
return v;
|
|
||||||
}
|
|
||||||
type_error("apply", "function", f);
|
|
||||||
return NIL;
|
|
||||||
}
|
|
443
tiny/evalt
443
tiny/evalt
|
@ -1,443 +0,0 @@
|
||||||
value_t eval_sexpr(value_t e, value_t *penv)
|
|
||||||
{
|
|
||||||
value_t f, v, bind, headsym, asym, labl=0, *pv, *argsyms, *body, *lenv;
|
|
||||||
value_t *rest;
|
|
||||||
cons_t *c;
|
|
||||||
symbol_t *sym;
|
|
||||||
u_int32_t saveSP;
|
|
||||||
int i, nargs, noeval=0;
|
|
||||||
number_t s, n;
|
|
||||||
|
|
||||||
eval_top:
|
|
||||||
if (issymbol(e)) {
|
|
||||||
sym = (symbol_t*)ptr(e);
|
|
||||||
if (sym->constant != UNBOUND) return sym->constant;
|
|
||||||
v = *penv;
|
|
||||||
while (iscons(v)) {
|
|
||||||
bind = car_(v);
|
|
||||||
if (iscons(bind) && car_(bind) == e)
|
|
||||||
return cdr_(bind);
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
if ((v = sym->binding) == UNBOUND)
|
|
||||||
lerror("eval: error: variable %s has no value\n", sym->name);
|
|
||||||
return v;
|
|
||||||
}
|
|
||||||
if ((unsigned)(char*)&nargs < (unsigned)stack_bottom || SP>=(N_STACK-100))
|
|
||||||
lerror("eval: error: stack overflow\n");
|
|
||||||
saveSP = SP;
|
|
||||||
PUSH(e);
|
|
||||||
PUSH(*penv);
|
|
||||||
f = eval(car_(e), penv);
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
if (isbuiltin(f)) {
|
|
||||||
// handle builtin function
|
|
||||||
if (!isspecial(f)) {
|
|
||||||
// evaluate argument list, placing arguments on stack
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
while (iscons(v)) {
|
|
||||||
v = eval(car_(v), penv);
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
PUSH(v);
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
apply_builtin:
|
|
||||||
nargs = SP - saveSP - 2;
|
|
||||||
switch (intval(f)) {
|
|
||||||
// special forms
|
|
||||||
case F_QUOTE:
|
|
||||||
v = cdr_(Stack[saveSP]);
|
|
||||||
if (!iscons(v))
|
|
||||||
lerror("quote: error: expected argument\n");
|
|
||||||
v = car_(v);
|
|
||||||
break;
|
|
||||||
case F_MACRO:
|
|
||||||
case F_LAMBDA:
|
|
||||||
v = Stack[saveSP];
|
|
||||||
if (*penv != NIL) {
|
|
||||||
// build a closure (lambda args body . env)
|
|
||||||
v = cdr_(v);
|
|
||||||
PUSH(car(v));
|
|
||||||
argsyms = &Stack[SP-1];
|
|
||||||
PUSH(car(cdr_(v)));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
v = cons_(intval(f)==F_LAMBDA ? &LAMBDA : &MACRO,
|
|
||||||
cons(argsyms, cons(body, penv)));
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_LABEL:
|
|
||||||
v = Stack[saveSP];
|
|
||||||
if (*penv != NIL) {
|
|
||||||
v = cdr_(v);
|
|
||||||
PUSH(car(v)); // name
|
|
||||||
pv = &Stack[SP-1];
|
|
||||||
PUSH(car(cdr_(v))); // function
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
*body = eval(*body, penv); // evaluate lambda
|
|
||||||
v = cons_(&LABEL, cons(pv, cons(body, &NIL)));
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_IF:
|
|
||||||
v = car(cdr_(Stack[saveSP]));
|
|
||||||
if (eval(v, penv) != NIL)
|
|
||||||
v = car(cdr_(cdr_(Stack[saveSP])));
|
|
||||||
else
|
|
||||||
v = car(cdr(cdr_(cdr_(Stack[saveSP]))));
|
|
||||||
tail_eval(v, Stack[saveSP+1]);
|
|
||||||
break;
|
|
||||||
case F_COND:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
while (iscons(*pv)) {
|
|
||||||
c = tocons(car_(*pv), "cond");
|
|
||||||
v = eval(c->car, penv);
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
if (v != NIL) {
|
|
||||||
*pv = cdr_(car_(*pv));
|
|
||||||
// evaluate body forms
|
|
||||||
if (iscons(*pv)) {
|
|
||||||
while (iscons(cdr_(*pv))) {
|
|
||||||
v = eval(car_(*pv), penv);
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
tail_eval(car_(*pv), *penv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_AND:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = T;
|
|
||||||
if (iscons(*pv)) {
|
|
||||||
while (iscons(cdr_(*pv))) {
|
|
||||||
if ((v=eval(car_(*pv), penv)) == NIL) {
|
|
||||||
SP = saveSP; return NIL;
|
|
||||||
}
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
tail_eval(car_(*pv), *penv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_OR:
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
if (iscons(*pv)) {
|
|
||||||
while (iscons(cdr_(*pv))) {
|
|
||||||
if ((v=eval(car_(*pv), penv)) != NIL) {
|
|
||||||
SP = saveSP; return v;
|
|
||||||
}
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
tail_eval(car_(*pv), *penv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case F_WHILE:
|
|
||||||
PUSH(car(cdr(cdr_(Stack[saveSP]))));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
Stack[saveSP] = car_(cdr_(Stack[saveSP]));
|
|
||||||
value_t *cond = &Stack[saveSP];
|
|
||||||
PUSH(NIL); pv = &Stack[SP-1];
|
|
||||||
while (eval(*cond, penv) != NIL) {
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
*pv = eval(*body, penv);
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
}
|
|
||||||
v = *pv;
|
|
||||||
break;
|
|
||||||
case F_PROGN:
|
|
||||||
// return last arg
|
|
||||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
pv = &Stack[saveSP]; v = NIL;
|
|
||||||
if (iscons(*pv)) {
|
|
||||||
while (iscons(cdr_(*pv))) {
|
|
||||||
v = eval(car_(*pv), penv);
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
*pv = cdr_(*pv);
|
|
||||||
}
|
|
||||||
tail_eval(car_(*pv), *penv);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
|
|
||||||
// ordinary functions
|
|
||||||
case F_SET:
|
|
||||||
argcount("set", nargs, 2);
|
|
||||||
e = Stack[SP-2];
|
|
||||||
v = *penv;
|
|
||||||
while (iscons(v)) {
|
|
||||||
bind = car_(v);
|
|
||||||
if (iscons(bind) && car_(bind) == e) {
|
|
||||||
cdr_(bind) = (v=Stack[SP-1]);
|
|
||||||
SP=saveSP; return v;
|
|
||||||
}
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
tosymbol(e, "set")->binding = (v=Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_BOUNDP:
|
|
||||||
argcount("boundp", nargs, 1);
|
|
||||||
if (tosymbol(Stack[SP-1], "boundp")->binding == UNBOUND)
|
|
||||||
v = NIL;
|
|
||||||
else
|
|
||||||
v = T;
|
|
||||||
break;
|
|
||||||
case F_EQ:
|
|
||||||
argcount("eq", nargs, 2);
|
|
||||||
v = ((Stack[SP-2] == Stack[SP-1]) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_CONS:
|
|
||||||
argcount("cons", nargs, 2);
|
|
||||||
v = mk_cons();
|
|
||||||
car_(v) = Stack[SP-2];
|
|
||||||
cdr_(v) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_CAR:
|
|
||||||
argcount("car", nargs, 1);
|
|
||||||
v = car(Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_CDR:
|
|
||||||
argcount("cdr", nargs, 1);
|
|
||||||
v = cdr(Stack[SP-1]);
|
|
||||||
break;
|
|
||||||
case F_RPLACA:
|
|
||||||
argcount("rplaca", nargs, 2);
|
|
||||||
car(v=Stack[SP-2]) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_RPLACD:
|
|
||||||
argcount("rplacd", nargs, 2);
|
|
||||||
cdr(v=Stack[SP-2]) = Stack[SP-1];
|
|
||||||
break;
|
|
||||||
case F_ATOM:
|
|
||||||
argcount("atom", nargs, 1);
|
|
||||||
v = ((!iscons(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_CONSP:
|
|
||||||
argcount("consp", nargs, 1);
|
|
||||||
v = (iscons(Stack[SP-1]) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_SYMBOLP:
|
|
||||||
argcount("symbolp", nargs, 1);
|
|
||||||
v = ((issymbol(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_NUMBERP:
|
|
||||||
argcount("numberp", nargs, 1);
|
|
||||||
v = ((isnumber(Stack[SP-1])) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_ADD:
|
|
||||||
s = 0;
|
|
||||||
for (i=saveSP+2; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "+");
|
|
||||||
s += n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_SUB:
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("-: error: too few arguments\n");
|
|
||||||
i = saveSP+2;
|
|
||||||
s = (nargs==1) ? 0 : tonumber(Stack[i++], "-");
|
|
||||||
for (; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "-");
|
|
||||||
s -= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_MUL:
|
|
||||||
s = 1;
|
|
||||||
for (i=saveSP+2; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "*");
|
|
||||||
s *= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_DIV:
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("/: error: too few arguments\n");
|
|
||||||
i = saveSP+2;
|
|
||||||
s = (nargs==1) ? 1 : tonumber(Stack[i++], "/");
|
|
||||||
for (; i < (int)SP; i++) {
|
|
||||||
n = tonumber(Stack[i], "/");
|
|
||||||
if (n == 0)
|
|
||||||
lerror("/: error: division by zero\n");
|
|
||||||
s /= n;
|
|
||||||
}
|
|
||||||
v = number(s);
|
|
||||||
break;
|
|
||||||
case F_LT:
|
|
||||||
argcount("<", nargs, 2);
|
|
||||||
if (tonumber(Stack[SP-2],"<") < tonumber(Stack[SP-1],"<"))
|
|
||||||
v = T;
|
|
||||||
else
|
|
||||||
v = NIL;
|
|
||||||
break;
|
|
||||||
case F_NOT:
|
|
||||||
argcount("not", nargs, 1);
|
|
||||||
v = ((Stack[SP-1] == NIL) ? T : NIL);
|
|
||||||
break;
|
|
||||||
case F_EVAL:
|
|
||||||
argcount("eval", nargs, 1);
|
|
||||||
v = Stack[SP-1];
|
|
||||||
tail_eval(v, NIL);
|
|
||||||
break;
|
|
||||||
case F_PRINT:
|
|
||||||
for (i=saveSP+2; i < (int)SP; i++)
|
|
||||||
print(stdout, v=Stack[i], 0);
|
|
||||||
fprintf(stdout, "\n");
|
|
||||||
break;
|
|
||||||
case F_PRINC:
|
|
||||||
for (i=saveSP+2; i < (int)SP; i++)
|
|
||||||
print(stdout, v=Stack[i], 1);
|
|
||||||
break;
|
|
||||||
case F_READ:
|
|
||||||
argcount("read", nargs, 0);
|
|
||||||
v = read_sexpr(stdin);
|
|
||||||
break;
|
|
||||||
case F_LOAD:
|
|
||||||
argcount("load", nargs, 1);
|
|
||||||
v = load_file(tosymbol(Stack[SP-1], "load")->name);
|
|
||||||
break;
|
|
||||||
case F_EXIT:
|
|
||||||
exit(0);
|
|
||||||
break;
|
|
||||||
case F_ERROR:
|
|
||||||
for (i=saveSP+2; i < (int)SP; i++)
|
|
||||||
print(stderr, Stack[i], 1);
|
|
||||||
lerror("\n");
|
|
||||||
break;
|
|
||||||
case F_PROG1:
|
|
||||||
// return first arg
|
|
||||||
if (nargs < 1)
|
|
||||||
lerror("prog1: error: too few arguments\n");
|
|
||||||
v = Stack[saveSP+2];
|
|
||||||
break;
|
|
||||||
case F_APPLY:
|
|
||||||
argcount("apply", nargs, 2);
|
|
||||||
v = Stack[saveSP] = Stack[SP-1]; // second arg is new arglist
|
|
||||||
f = Stack[SP-2]; // first arg is new function
|
|
||||||
POPN(2); // pop apply's args
|
|
||||||
if (isbuiltin(f)) {
|
|
||||||
if (isspecial(f))
|
|
||||||
lerror("apply: error: cannot apply special operator "
|
|
||||||
"%s\n", builtin_names[intval(f)]);
|
|
||||||
// unpack arglist onto the stack
|
|
||||||
while (iscons(v)) {
|
|
||||||
PUSH(car_(v));
|
|
||||||
v = cdr_(v);
|
|
||||||
}
|
|
||||||
goto apply_builtin;
|
|
||||||
}
|
|
||||||
noeval = 1;
|
|
||||||
goto apply_lambda;
|
|
||||||
}
|
|
||||||
SP = saveSP;
|
|
||||||
return v;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
apply_lambda:
|
|
||||||
if (iscons(f)) {
|
|
||||||
headsym = car_(f);
|
|
||||||
if (headsym == LABEL) {
|
|
||||||
// (label name (lambda ...)) behaves the same as the lambda
|
|
||||||
// alone, except with name bound to the whole label expression
|
|
||||||
labl = f;
|
|
||||||
f = car(cdr(cdr_(labl)));
|
|
||||||
headsym = car(f);
|
|
||||||
}
|
|
||||||
// apply lambda or macro expression
|
|
||||||
PUSH(cdr(cdr(cdr_(f))));
|
|
||||||
lenv = &Stack[SP-1];
|
|
||||||
PUSH(car_(cdr_(f)));
|
|
||||||
argsyms = &Stack[SP-1];
|
|
||||||
PUSH(car_(cdr_(cdr_(f))));
|
|
||||||
body = &Stack[SP-1];
|
|
||||||
if (labl) {
|
|
||||||
// add label binding to environment
|
|
||||||
PUSH(labl);
|
|
||||||
PUSH(car_(cdr_(labl)));
|
|
||||||
*lenv = cons_(cons(&Stack[SP-1], &Stack[SP-2]), lenv);
|
|
||||||
POPN(3);
|
|
||||||
v = Stack[saveSP]; // refetch arglist
|
|
||||||
}
|
|
||||||
if (headsym == MACRO)
|
|
||||||
noeval = 1;
|
|
||||||
else if (headsym != LAMBDA)
|
|
||||||
lerror("apply: error: head must be lambda, macro, or label\n");
|
|
||||||
// build a calling environment for the lambda
|
|
||||||
// the environment is the argument binds on top of the captured
|
|
||||||
// environment
|
|
||||||
while (iscons(v)) {
|
|
||||||
// bind args
|
|
||||||
if (!iscons(*argsyms)) {
|
|
||||||
if (*argsyms == NIL)
|
|
||||||
lerror("apply: error: too many arguments\n");
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
asym = car_(*argsyms);
|
|
||||||
if (!issymbol(asym))
|
|
||||||
lerror("apply: error: formal argument not a symbol\n");
|
|
||||||
v = car_(v);
|
|
||||||
if (!noeval) {
|
|
||||||
v = eval(v, penv);
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
}
|
|
||||||
PUSH(v);
|
|
||||||
*lenv = cons_(cons(&asym, &Stack[SP-1]), lenv);
|
|
||||||
POPN(2);
|
|
||||||
*argsyms = cdr_(*argsyms);
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
if (*argsyms != NIL) {
|
|
||||||
if (issymbol(*argsyms)) {
|
|
||||||
if (noeval) {
|
|
||||||
*lenv = cons_(cons(argsyms, &Stack[saveSP]), lenv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
PUSH(NIL);
|
|
||||||
PUSH(NIL);
|
|
||||||
rest = &Stack[SP-1];
|
|
||||||
// build list of rest arguments
|
|
||||||
// we have to build it forwards, which is tricky
|
|
||||||
while (iscons(v)) {
|
|
||||||
v = eval(car_(v), penv);
|
|
||||||
*penv = Stack[saveSP+1];
|
|
||||||
PUSH(v);
|
|
||||||
v = cons_(&Stack[SP-1], &NIL);
|
|
||||||
POP();
|
|
||||||
if (iscons(*rest))
|
|
||||||
cdr_(*rest) = v;
|
|
||||||
else
|
|
||||||
Stack[SP-2] = v;
|
|
||||||
*rest = v;
|
|
||||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
|
||||||
}
|
|
||||||
*lenv = cons_(cons(argsyms, &Stack[SP-2]), lenv);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else if (iscons(*argsyms)) {
|
|
||||||
lerror("apply: error: too few arguments\n");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
noeval = 0;
|
|
||||||
// macro: evaluate expansion in the calling environment
|
|
||||||
if (headsym == MACRO) {
|
|
||||||
SP = saveSP;
|
|
||||||
PUSH(*lenv);
|
|
||||||
lenv = &Stack[SP-1];
|
|
||||||
v = eval(*body, lenv);
|
|
||||||
tail_eval(v, *penv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
tail_eval(*body, *lenv);
|
|
||||||
}
|
|
||||||
// not reached
|
|
||||||
}
|
|
||||||
type_error("apply", "function", f);
|
|
||||||
return NIL;
|
|
||||||
}
|
|
117
tiny/flutils.c
117
tiny/flutils.c
|
@ -1,117 +0,0 @@
|
||||||
u_int32_t *bitvector_resize(u_int32_t *b, size_t n)
|
|
||||||
{
|
|
||||||
u_int32_t *p;
|
|
||||||
size_t sz = ((n + 31) >> 5) * 4;
|
|
||||||
p = realloc(b, sz);
|
|
||||||
if (p == NULL)
|
|
||||||
return NULL;
|
|
||||||
memset(p, 0, sz);
|
|
||||||
return p;
|
|
||||||
}
|
|
||||||
|
|
||||||
u_int32_t *mk_bitvector(size_t n) { return bitvector_resize(NULL, n); }
|
|
||||||
|
|
||||||
void bitvector_set(u_int32_t *b, u_int32_t n, u_int32_t c)
|
|
||||||
{
|
|
||||||
if (c)
|
|
||||||
b[n >> 5] |= (1 << (n & 31));
|
|
||||||
else
|
|
||||||
b[n >> 5] &= ~(1 << (n & 31));
|
|
||||||
}
|
|
||||||
|
|
||||||
u_int32_t bitvector_get(u_int32_t *b, u_int32_t n)
|
|
||||||
{
|
|
||||||
return b[n >> 5] & (1 << (n & 31));
|
|
||||||
}
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
size_t n, maxsize;
|
|
||||||
unsigned long *items;
|
|
||||||
} ltable_t;
|
|
||||||
|
|
||||||
void ltable_init(ltable_t *t, size_t n)
|
|
||||||
{
|
|
||||||
t->n = 0;
|
|
||||||
t->maxsize = n;
|
|
||||||
t->items = (unsigned long *)malloc(n * sizeof(unsigned long));
|
|
||||||
}
|
|
||||||
|
|
||||||
void ltable_clear(ltable_t *t) { t->n = 0; }
|
|
||||||
|
|
||||||
void ltable_insert(ltable_t *t, unsigned long item)
|
|
||||||
{
|
|
||||||
unsigned long *p;
|
|
||||||
|
|
||||||
if (t->n == t->maxsize) {
|
|
||||||
p = realloc(t->items, (t->maxsize * 2) * sizeof(unsigned long));
|
|
||||||
if (p == NULL)
|
|
||||||
return;
|
|
||||||
t->items = p;
|
|
||||||
t->maxsize *= 2;
|
|
||||||
}
|
|
||||||
t->items[t->n++] = item;
|
|
||||||
}
|
|
||||||
|
|
||||||
#define NOTFOUND ((int)-1)
|
|
||||||
|
|
||||||
int ltable_lookup(ltable_t *t, unsigned long item)
|
|
||||||
{
|
|
||||||
int i;
|
|
||||||
for (i = 0; i < (int)t->n; i++)
|
|
||||||
if (t->items[i] == item)
|
|
||||||
return i;
|
|
||||||
return NOTFOUND;
|
|
||||||
}
|
|
||||||
|
|
||||||
void ltable_adjoin(ltable_t *t, unsigned long item)
|
|
||||||
{
|
|
||||||
if (ltable_lookup(t, item) == NOTFOUND)
|
|
||||||
ltable_insert(t, item);
|
|
||||||
}
|
|
||||||
|
|
||||||
static const u_int32_t offsetsFromUTF8[6] = { 0x00000000UL, 0x00003080UL,
|
|
||||||
0x000E2080UL, 0x03C82080UL,
|
|
||||||
0xFA082080UL, 0x82082080UL };
|
|
||||||
|
|
||||||
static const char trailingBytesForUTF8[256] = {
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
|
||||||
1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
|
||||||
3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5
|
|
||||||
};
|
|
||||||
|
|
||||||
int u8_seqlen(const char c)
|
|
||||||
{
|
|
||||||
return trailingBytesForUTF8[(unsigned int)(unsigned char)c] + 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
#define UEOF ((u_int32_t)EOF)
|
|
||||||
|
|
||||||
u_int32_t u8_fgetc(FILE *f)
|
|
||||||
{
|
|
||||||
int amt = 0, sz, c;
|
|
||||||
u_int32_t ch = 0;
|
|
||||||
|
|
||||||
c = fgetc(f);
|
|
||||||
if (c == EOF)
|
|
||||||
return UEOF;
|
|
||||||
ch = (u_int32_t)c;
|
|
||||||
amt = sz = u8_seqlen(ch);
|
|
||||||
while (--amt) {
|
|
||||||
ch <<= 6;
|
|
||||||
c = fgetc(f);
|
|
||||||
if (c == EOF)
|
|
||||||
return UEOF;
|
|
||||||
ch += (u_int32_t)c;
|
|
||||||
}
|
|
||||||
ch -= offsetsFromUTF8[sz - 1];
|
|
||||||
|
|
||||||
return ch;
|
|
||||||
}
|
|
1032
tiny/lisp-nontail.c
1032
tiny/lisp-nontail.c
File diff suppressed because it is too large
Load Diff
1099
tiny/lisp.c
1099
tiny/lisp.c
File diff suppressed because it is too large
Load Diff
1525
tiny/lisp2.c
1525
tiny/lisp2.c
File diff suppressed because it is too large
Load Diff
1109
tiny/lispf.c
1109
tiny/lispf.c
File diff suppressed because it is too large
Load Diff
426
tiny/system.lsp
426
tiny/system.lsp
|
@ -1,426 +0,0 @@
|
||||||
; femtoLisp standard library
|
|
||||||
; by Jeff Bezanson
|
|
||||||
; Public Domain
|
|
||||||
|
|
||||||
(set 'list (lambda args args))
|
|
||||||
|
|
||||||
(set 'setq (macro (name val)
|
|
||||||
(list set (list quote name) val)))
|
|
||||||
|
|
||||||
(setq sp '| |)
|
|
||||||
(setq nl '|
|
|
||||||
|)
|
|
||||||
|
|
||||||
; convert a sequence of body statements to a single expression.
|
|
||||||
; this allows define, defun, defmacro, let, etc. to contain multiple
|
|
||||||
; body expressions as in Common Lisp.
|
|
||||||
(setq f-body (lambda (e)
|
|
||||||
(cond ((atom e) e)
|
|
||||||
((eq (cdr e) ()) (car e))
|
|
||||||
(t (cons progn e)))))
|
|
||||||
|
|
||||||
(setq defmacro
|
|
||||||
(macro (name args . body)
|
|
||||||
(list 'setq name (list 'macro args (f-body body)))))
|
|
||||||
|
|
||||||
; support both CL defun and Scheme-style define
|
|
||||||
(defmacro defun (name args . body)
|
|
||||||
(list 'setq name (list 'lambda args (f-body body))))
|
|
||||||
|
|
||||||
(defmacro define (name . body)
|
|
||||||
(if (symbolp name)
|
|
||||||
(list 'setq name (car body))
|
|
||||||
(cons 'defun (cons (car name) (cons (cdr name) body)))))
|
|
||||||
|
|
||||||
(defun identity (x) x)
|
|
||||||
(setq null not)
|
|
||||||
(defun consp (x) (not (atom x)))
|
|
||||||
|
|
||||||
(defun map (f lst)
|
|
||||||
(if (atom lst) lst
|
|
||||||
(cons (f (car lst)) (map f (cdr lst)))))
|
|
||||||
|
|
||||||
(defmacro let (binds . body)
|
|
||||||
(cons (list 'lambda (map car binds) (f-body body))
|
|
||||||
(map cadr binds)))
|
|
||||||
|
|
||||||
(defun nconc lsts
|
|
||||||
(cond ((null lsts) ())
|
|
||||||
((null (cdr lsts)) (car lsts))
|
|
||||||
(t ((lambda (l d) (if (null l) d
|
|
||||||
(prog1 l
|
|
||||||
(while (consp (cdr l)) (set 'l (cdr l)))
|
|
||||||
(rplacd l d))))
|
|
||||||
(car lsts) (apply nconc (cdr lsts))))))
|
|
||||||
|
|
||||||
(defun append lsts
|
|
||||||
(cond ((null lsts) ())
|
|
||||||
((null (cdr lsts)) (car lsts))
|
|
||||||
(t ((label append2 (lambda (l d)
|
|
||||||
(if (null l) d
|
|
||||||
(cons (car l)
|
|
||||||
(append2 (cdr l) d)))))
|
|
||||||
(car lsts) (apply append (cdr lsts))))))
|
|
||||||
|
|
||||||
(defun member (item lst)
|
|
||||||
(cond ((atom lst) ())
|
|
||||||
((eq (car lst) item) lst)
|
|
||||||
(t (member item (cdr lst)))))
|
|
||||||
|
|
||||||
(defun macrop (e) (and (consp e) (eq (car e) 'macro) e))
|
|
||||||
(defun macrocallp (e) (and (symbolp (car e))
|
|
||||||
(boundp (car e))
|
|
||||||
(macrop (eval (car e)))))
|
|
||||||
(defun macroapply (m args) (apply (cons 'lambda (cdr m)) args))
|
|
||||||
|
|
||||||
(defun macroexpand-1 (e)
|
|
||||||
(if (atom e) e
|
|
||||||
(let ((f (macrocallp e)))
|
|
||||||
(if f (macroapply f (cdr e))
|
|
||||||
e))))
|
|
||||||
|
|
||||||
; convert to proper list, i.e. remove "dots", and append
|
|
||||||
(defun append.2 (l tail)
|
|
||||||
(cond ((null l) tail)
|
|
||||||
((atom l) (cons l tail))
|
|
||||||
(t (cons (car l) (append.2 (cdr l) tail)))))
|
|
||||||
|
|
||||||
(defun macroexpand (e)
|
|
||||||
((label mexpand
|
|
||||||
(lambda (e env f)
|
|
||||||
(progn
|
|
||||||
(while (and (consp e)
|
|
||||||
(not (member (car e) env))
|
|
||||||
(set 'f (macrocallp e)))
|
|
||||||
(set 'e (macroapply f (cdr e))))
|
|
||||||
(if (and (consp e)
|
|
||||||
(not (or (eq (car e) 'quote)
|
|
||||||
(eq (car e) quote))))
|
|
||||||
(let ((newenv
|
|
||||||
(if (and (or (eq (car e) 'lambda) (eq (car e) 'macro))
|
|
||||||
(consp (cdr e)))
|
|
||||||
(append.2 (cadr e) env)
|
|
||||||
env)))
|
|
||||||
(map (lambda (x) (mexpand x newenv nil)) e))
|
|
||||||
e))))
|
|
||||||
e nil nil))
|
|
||||||
|
|
||||||
; uncomment this to macroexpand functions at definition time.
|
|
||||||
; makes typical code ~25% faster, but only works for defun expressions
|
|
||||||
; at the top level.
|
|
||||||
;(defmacro defun (name args . body)
|
|
||||||
; (list 'setq name (list 'lambda args (macroexpand (f-body body)))))
|
|
||||||
|
|
||||||
; same thing for macros. enabled by default because macros are usually
|
|
||||||
; defined at the top level.
|
|
||||||
(defmacro defmacro (name args . body)
|
|
||||||
(list 'setq name (list 'macro args (macroexpand (f-body body)))))
|
|
||||||
|
|
||||||
(setq = eq)
|
|
||||||
(setq eql eq)
|
|
||||||
(define (/= a b) (not (eq a b)))
|
|
||||||
(define != /=)
|
|
||||||
(define (> a b) (< b a))
|
|
||||||
(define (<= a b) (not (< b a)))
|
|
||||||
(define (>= a b) (not (< a b)))
|
|
||||||
(define (mod x y) (- x (* (/ x y) y)))
|
|
||||||
(define (abs x) (if (< x 0) (- x) x))
|
|
||||||
(define (truncate x) x)
|
|
||||||
(setq K prog1) ; K combinator ;)
|
|
||||||
(define (funcall f . args) (apply f args))
|
|
||||||
(define (symbol-function sym) (eval sym))
|
|
||||||
(define (symbol-value sym) (eval sym))
|
|
||||||
|
|
||||||
(define (caar x) (car (car x)))
|
|
||||||
(define (cadr x) (car (cdr x)))
|
|
||||||
(define (cdar x) (cdr (car x)))
|
|
||||||
(define (cddr x) (cdr (cdr x)))
|
|
||||||
(define (caaar x) (car (car (car x))))
|
|
||||||
(define (caadr x) (car (car (cdr x))))
|
|
||||||
(define (cadar x) (car (cdr (car x))))
|
|
||||||
(define (caddr x) (car (cdr (cdr x))))
|
|
||||||
(define (cdaar x) (cdr (car (car x))))
|
|
||||||
(define (cdadr x) (cdr (car (cdr x))))
|
|
||||||
(define (cddar x) (cdr (cdr (car x))))
|
|
||||||
(define (cdddr x) (cdr (cdr (cdr x))))
|
|
||||||
|
|
||||||
(define (equal a b)
|
|
||||||
(if (and (consp a) (consp b))
|
|
||||||
(and (equal (car a) (car b))
|
|
||||||
(equal (cdr a) (cdr b)))
|
|
||||||
(eq a b)))
|
|
||||||
|
|
||||||
; compare imposes an ordering on all values. yields -1 for a<b,
|
|
||||||
; 0 for a==b, and 1 for a>b. lists are compared up to the first
|
|
||||||
; point of difference.
|
|
||||||
(defun compare (a b)
|
|
||||||
(cond ((eq a b) 0)
|
|
||||||
((or (atom a) (atom b)) (if (< a b) -1 1))
|
|
||||||
(t (let ((c (compare (car a) (car b))))
|
|
||||||
(if (not (eq c 0))
|
|
||||||
c
|
|
||||||
(compare (cdr a) (cdr b)))))))
|
|
||||||
|
|
||||||
(defun every (pred lst)
|
|
||||||
(or (atom lst)
|
|
||||||
(and (pred (car lst))
|
|
||||||
(every pred (cdr lst)))))
|
|
||||||
|
|
||||||
(defun any (pred lst)
|
|
||||||
(and (consp lst)
|
|
||||||
(or (pred (car lst))
|
|
||||||
(any pred (cdr lst)))))
|
|
||||||
|
|
||||||
(defun listp (a) (or (eq a ()) (consp a)))
|
|
||||||
|
|
||||||
(defun length (l)
|
|
||||||
(if (null l) 0
|
|
||||||
(+ 1 (length (cdr l)))))
|
|
||||||
|
|
||||||
(defun nthcdr (n lst)
|
|
||||||
(if (<= n 0) lst
|
|
||||||
(nthcdr (- n 1) (cdr lst))))
|
|
||||||
|
|
||||||
(defun list-ref (lst n)
|
|
||||||
(car (nthcdr n lst)))
|
|
||||||
|
|
||||||
(defun list* l
|
|
||||||
(if (atom (cdr l))
|
|
||||||
(car l)
|
|
||||||
(cons (car l) (apply list* (cdr l)))))
|
|
||||||
|
|
||||||
(defun nlist* l
|
|
||||||
(if (atom (cdr l))
|
|
||||||
(car l)
|
|
||||||
(rplacd l (apply nlist* (cdr l)))))
|
|
||||||
|
|
||||||
(defun lastcdr (l)
|
|
||||||
(if (atom l) l
|
|
||||||
(lastcdr (cdr l))))
|
|
||||||
|
|
||||||
(defun last (l)
|
|
||||||
(cond ((atom l) l)
|
|
||||||
((atom (cdr l)) l)
|
|
||||||
(t (last (cdr l)))))
|
|
||||||
|
|
||||||
(defun map! (f lst)
|
|
||||||
(prog1 lst
|
|
||||||
(while (consp lst)
|
|
||||||
(rplaca lst (f (car lst)))
|
|
||||||
(set 'lst (cdr lst)))))
|
|
||||||
|
|
||||||
(defun mapcar (f . lsts)
|
|
||||||
((label mapcar-
|
|
||||||
(lambda (lsts)
|
|
||||||
(cond ((null lsts) (f))
|
|
||||||
((atom (car lsts)) (car lsts))
|
|
||||||
(t (cons (apply f (map car lsts))
|
|
||||||
(mapcar- (map cdr lsts)))))))
|
|
||||||
lsts))
|
|
||||||
|
|
||||||
(defun transpose (M) (apply mapcar (cons list M)))
|
|
||||||
|
|
||||||
(defun filter (pred lst)
|
|
||||||
(cond ((null lst) ())
|
|
||||||
((not (pred (car lst))) (filter pred (cdr lst)))
|
|
||||||
(t (cons (car lst) (filter pred (cdr lst))))))
|
|
||||||
|
|
||||||
(define (foldr f zero lst)
|
|
||||||
(if (null lst) zero
|
|
||||||
(f (car lst) (foldr f zero (cdr lst)))))
|
|
||||||
|
|
||||||
(define (foldl f zero lst)
|
|
||||||
(if (null lst) zero
|
|
||||||
(foldl f (f (car lst) zero) (cdr lst))))
|
|
||||||
|
|
||||||
(define (reverse lst) (foldl cons nil lst))
|
|
||||||
|
|
||||||
(define (reduce0 f zero lst)
|
|
||||||
(if (null lst) zero
|
|
||||||
(reduce0 f (f zero (car lst)) (cdr lst))))
|
|
||||||
|
|
||||||
(defun reduce (f lst)
|
|
||||||
(reduce0 f (car lst) (cdr lst)))
|
|
||||||
|
|
||||||
(define (copy-list l) (map identity l))
|
|
||||||
(define (copy-tree l)
|
|
||||||
(if (atom l) l
|
|
||||||
(cons (copy-tree (car l))
|
|
||||||
(copy-tree (cdr l)))))
|
|
||||||
|
|
||||||
(define (assoc item lst)
|
|
||||||
(cond ((atom lst) ())
|
|
||||||
((eq (caar lst) item) (car lst))
|
|
||||||
(t (assoc item (cdr lst)))))
|
|
||||||
|
|
||||||
(define (nreverse l)
|
|
||||||
(let ((prev nil))
|
|
||||||
(while (consp l)
|
|
||||||
(set 'l (prog1 (cdr l)
|
|
||||||
(rplacd l (prog1 prev
|
|
||||||
(set 'prev l))))))
|
|
||||||
prev))
|
|
||||||
|
|
||||||
(defmacro let* (binds . body)
|
|
||||||
(cons (list 'lambda (map car binds)
|
|
||||||
(cons progn
|
|
||||||
(nconc (map (lambda (b) (cons 'setq b)) binds)
|
|
||||||
body)))
|
|
||||||
(map (lambda (x) nil) binds)))
|
|
||||||
|
|
||||||
(defmacro labels (binds . body)
|
|
||||||
(cons (list 'lambda (map car binds)
|
|
||||||
(cons progn
|
|
||||||
(nconc (map (lambda (b)
|
|
||||||
(list 'setq (car b) (cons 'lambda (cdr b))))
|
|
||||||
binds)
|
|
||||||
body)))
|
|
||||||
(map (lambda (x) nil) binds)))
|
|
||||||
|
|
||||||
(defmacro when (c . body) (list if c (f-body body) nil))
|
|
||||||
(defmacro unless (c . body) (list if c nil (f-body body)))
|
|
||||||
|
|
||||||
(defmacro dotimes (var . body)
|
|
||||||
(let ((v (car var))
|
|
||||||
(cnt (cadr var)))
|
|
||||||
(list 'let (list (list v 0))
|
|
||||||
(list while (list < v cnt)
|
|
||||||
(list prog1 (f-body body) (list 'setq v (list + v 1)))))))
|
|
||||||
|
|
||||||
(defun map-int (f n)
|
|
||||||
(let ((acc nil))
|
|
||||||
(dotimes (i n)
|
|
||||||
(setq acc (cons (f i) acc)))
|
|
||||||
(nreverse acc)))
|
|
||||||
|
|
||||||
; property lists
|
|
||||||
(setq *plists* nil)
|
|
||||||
|
|
||||||
(defun symbol-plist (sym)
|
|
||||||
(cdr (or (assoc sym *plists*) '(()))))
|
|
||||||
|
|
||||||
(defun set-symbol-plist (sym lst)
|
|
||||||
(let ((p (assoc sym *plists*)))
|
|
||||||
(if (null p) ; sym has no plist yet
|
|
||||||
(setq *plists* (cons (cons sym lst) *plists*))
|
|
||||||
(rplacd p lst))))
|
|
||||||
|
|
||||||
(defun get (sym prop)
|
|
||||||
(let ((pl (symbol-plist sym)))
|
|
||||||
(if pl
|
|
||||||
(let ((pr (member prop pl)))
|
|
||||||
(if pr (cadr pr) nil))
|
|
||||||
nil)))
|
|
||||||
|
|
||||||
(defun put (sym prop val)
|
|
||||||
(let ((p (assoc sym *plists*)))
|
|
||||||
(if (null p) ; sym has no plist yet
|
|
||||||
(setq *plists* (cons (list sym prop val) *plists*))
|
|
||||||
(let ((pr (member prop p)))
|
|
||||||
(if (null pr) ; sym doesn't have this property yet
|
|
||||||
(rplacd p (cons prop (cons val (cdr p))))
|
|
||||||
(rplaca (cdr pr) val)))))
|
|
||||||
val)
|
|
||||||
|
|
||||||
; setf
|
|
||||||
; expands (setf (place x ...) v) to (mutator (f x ...) v)
|
|
||||||
; (mutator (identity x ...) v) is interpreted as (mutator x ... v)
|
|
||||||
(setq *setf-place-list*
|
|
||||||
; place mutator f
|
|
||||||
'((car rplaca identity)
|
|
||||||
(cdr rplacd identity)
|
|
||||||
(caar rplaca car)
|
|
||||||
(cadr rplaca cdr)
|
|
||||||
(cdar rplacd car)
|
|
||||||
(cddr rplacd cdr)
|
|
||||||
(caaar rplaca caar)
|
|
||||||
(caadr rplaca cadr)
|
|
||||||
(cadar rplaca cdar)
|
|
||||||
(caddr rplaca cddr)
|
|
||||||
(cdaar rplacd caar)
|
|
||||||
(cdadr rplacd cadr)
|
|
||||||
(cddar rplacd cdar)
|
|
||||||
(cdddr rplacd cddr)
|
|
||||||
(get put identity)
|
|
||||||
(aref aset identity)
|
|
||||||
(symbol-function set identity)
|
|
||||||
(symbol-value set identity)
|
|
||||||
(symbol-plist set-symbol-plist identity)))
|
|
||||||
|
|
||||||
(defun setf-place-mutator (place val)
|
|
||||||
(if (symbolp place)
|
|
||||||
(list 'setq place val)
|
|
||||||
(let ((mutator (assoc (car place) *setf-place-list*)))
|
|
||||||
(if (null mutator)
|
|
||||||
(error '|setf: error: unknown place | (car place))
|
|
||||||
(if (eq (caddr mutator) 'identity)
|
|
||||||
(cons (cadr mutator) (append (cdr place) (list val)))
|
|
||||||
(list (cadr mutator)
|
|
||||||
(cons (caddr mutator) (cdr place))
|
|
||||||
val))))))
|
|
||||||
|
|
||||||
(defmacro setf args
|
|
||||||
(f-body
|
|
||||||
((label setf-
|
|
||||||
(lambda (args)
|
|
||||||
(if (null args)
|
|
||||||
nil
|
|
||||||
(cons (setf-place-mutator (car args) (cadr args))
|
|
||||||
(setf- (cddr args))))))
|
|
||||||
args)))
|
|
||||||
|
|
||||||
(defun revappend (l1 l2) (nconc (reverse l1) l2))
|
|
||||||
(defun nreconc (l1 l2) (nconc (nreverse l1) l2))
|
|
||||||
|
|
||||||
(defun builtinp (x)
|
|
||||||
(and (atom x)
|
|
||||||
(not (symbolp x))
|
|
||||||
(not (numberp x))))
|
|
||||||
|
|
||||||
(defun self-evaluating-p (x)
|
|
||||||
(or (eq x nil)
|
|
||||||
(eq x t)
|
|
||||||
(and (atom x)
|
|
||||||
(not (symbolp x)))))
|
|
||||||
|
|
||||||
; backquote
|
|
||||||
(defmacro backquote (x) (bq-process x))
|
|
||||||
|
|
||||||
(defun splice-form-p (x)
|
|
||||||
(or (and (consp x) (or (eq (car x) '*comma-at*)
|
|
||||||
(eq (car x) '*comma-dot*)))
|
|
||||||
(eq x '*comma*)))
|
|
||||||
|
|
||||||
(defun bq-process (x)
|
|
||||||
(cond ((self-evaluating-p x) x)
|
|
||||||
((atom x) (list quote x))
|
|
||||||
((eq (car x) 'backquote) (bq-process (bq-process (cadr x))))
|
|
||||||
((eq (car x) '*comma*) (cadr x))
|
|
||||||
((not (any splice-form-p x))
|
|
||||||
(let ((lc (lastcdr x))
|
|
||||||
(forms (map bq-bracket1 x)))
|
|
||||||
(if (null lc)
|
|
||||||
(cons 'list forms)
|
|
||||||
(nconc (cons 'nlist* forms) (list (bq-process lc))))))
|
|
||||||
(t (let ((p x) (q '()))
|
|
||||||
(while (and (consp p)
|
|
||||||
(not (eq (car p) '*comma*)))
|
|
||||||
(setq q (cons (bq-bracket (car p)) q))
|
|
||||||
(setq p (cdr p)))
|
|
||||||
(cons 'nconc
|
|
||||||
(cond ((consp p) (nreconc q (list (cadr p))))
|
|
||||||
((null p) (nreverse q))
|
|
||||||
(t (nreconc q (list (bq-process p))))))))))
|
|
||||||
|
|
||||||
(defun bq-bracket (x)
|
|
||||||
(cond ((atom x) (list cons (bq-process x) nil))
|
|
||||||
((eq (car x) '*comma*) (list cons (cadr x) nil))
|
|
||||||
((eq (car x) '*comma-at*) (list 'copy-list (cadr x)))
|
|
||||||
((eq (car x) '*comma-dot*) (cadr x))
|
|
||||||
(t (list cons (bq-process x) nil))))
|
|
||||||
|
|
||||||
; bracket without splicing
|
|
||||||
(defun bq-bracket1 (x)
|
|
||||||
(if (and (consp x) (eq (car x) '*comma*))
|
|
||||||
(cadr x)
|
|
||||||
(bq-process x)))
|
|
41
todo-scrap
41
todo-scrap
|
@ -1,41 +0,0 @@
|
||||||
- readable gensyms. have uninterned symbols, but have all same-named
|
|
||||||
gensyms read to the same (eq) symbol within an expression.
|
|
||||||
- fat pointers, i.e. 64 bits on 32-bit platforms. we could have full 32-bit
|
|
||||||
integers too. the mind boggles at the possibilities.
|
|
||||||
(it would be great if everybody decided that pointer types should forever
|
|
||||||
be wider than address spaces, with some bits reserved for application use)
|
|
||||||
- any way at all to provide O(1) computed lookups (i.e. indexing).
|
|
||||||
CL uses vectors for this. once you have it, it's sufficient to get
|
|
||||||
efficient hash tables and everything else.
|
|
||||||
- could be done just by generalizing cons cells to have more than
|
|
||||||
car, cdr: c2r, c3r, etc. maybe (1 . 2 . 3 . 4 . ...)
|
|
||||||
all you need is a tag+size on the front of the object so the collector
|
|
||||||
knows how to deal with it.
|
|
||||||
(car x) == (ref x 0), etc.
|
|
||||||
(rplaca x v) == (rplac x 0 v), etc.
|
|
||||||
(size (cons 1 2)) == 2, etc.
|
|
||||||
- one possibility: if we see a cons whose CAR is tagptr(0x10,TAG_SYM),
|
|
||||||
then the CDR is the size and the following words are the elements.
|
|
||||||
. this approach is especially good if vectors are separate types from
|
|
||||||
conses
|
|
||||||
- another: add u_int32_t size to cons_t, making them all 50% bigger.
|
|
||||||
access is simpler and more uniform, without fully doubling the size like
|
|
||||||
we'd get with fat pointers.
|
|
||||||
|
|
||||||
Notice that the size is one byte more than the number of characters in
|
|
||||||
the string. This is because femtoLisp adds a NUL terminator to make its
|
|
||||||
strings compatible with C. No effort is made to hide this fact.
|
|
||||||
But since femtoLisp tracks the sizes of cvalues, it doesn't need the
|
|
||||||
terminator itself. Therefore it treats zero bytes specially as rarely
|
|
||||||
as possible. In particular, zeros are only special in values whose type
|
|
||||||
is exactly <tt>(array char)</tt>, and are only interpreted in the
|
|
||||||
following cases:
|
|
||||||
<ul>
|
|
||||||
<li>When printing strings, a final NUL is never printed. NULs in the
|
|
||||||
middle of a string are printed though.
|
|
||||||
<li>String constructors NUL-terminate their output.
|
|
||||||
<li>Explicit string functions (like <tt>strlen</tt>) treat NULs the same
|
|
||||||
way equivalent C functions would.
|
|
||||||
</ul>
|
|
||||||
Arrays of uchar, int8, etc. are treated as raw data and zero bytes are
|
|
||||||
never special.
|
|
Loading…
Reference in New Issue